CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
radiation_gases.f
1
5
6! ========================================================== !!!!!
7! 'module_radiation_gases' description !!!!!
8! ========================================================== !!!!!
9! !
10! set up constant gas profiles, such as co2, ch4, n2o, o2, and those !
11! of cfc gases. All data are entered as mixing ratio by volume !
12! !
13! in the module, the externally callabe subroutines are : !
14! !
15! 'gas_init' -- initialization !
16! input: !
17! ( me ) !
18! output: !
19! ( errflg, errmsg ) !
20! !
21! 'gas_update' -- read in data and update with time !
22! input: !
23! ( iyear, imon, iday, ihour, ldoco2, me ) !
24! output: !
25! ( errflg, errmsg ) !
26! !
27! !
28! 'getgases' -- setup constant gas profiles for LW and SW !
29! input: !
30! ( plvl, xlon, xlat, !
31! IMAX, LMAX ) !
32! output: !
33! ( gasdat ) !
34! !
35! external modules referenced: !
36! 'module machine' in 'machine.f' !
37! 'module funcphys' in 'funcphys.f' !
38! 'module module_iounitdef' in 'iounitdef.f' !
39! !
40! unit used for radiative active gases: !
41! co2 : volume mixing ratio (p/p) !
42! n2o : volume mixing ratio (p/p) !
43! ch4 : volume mixing ratio (p/p) !
44! o2 : volume mixing ratio (p/p) !
45! co : volume mixing ratio (p/p) !
46! cfc11 : volume mixing ratio (p/p) !
47! cfc12 : volume mixing ratio (p/p) !
48! cfc22 : volume mixing ratio (p/p) !
49! ccl4 : volume mixing ratio (p/p) !
50! cfc113: volume mixing ratio (p/p) !
51! !
52! !
53! program history: !
54! may 2003 - y-t hou create rad_module.f that collectively !
55! combines several radiation computation supporting !
56! programs into fortran 90 module structure (gases !
57! and aerosols, etc.) !
58! apr 2004 - y-t hou modified to add astronomy and surface !
59! module components. !
60! feb 2005 - y-t hou rewrite the component modules into !
61! separate individule modules for thier corresponding !
62! tasks. here as radiation_gases.f !
63! mar 2006 - y-t hou add initialization subroutine to co2 and !
64! other gases. historical 2-d co2 data are added. !
65! sep 2008 - y-t hou add parameter ictm to control the input !
66! data time at the model initial condition. !
67! oct 2008 - y-t hou modify the initialization code to add the !
68! option of superimposing climatology seasonal cycle !
69! to the initial condition data (currently co2 only) !
70! nov 2008 - y-t hou fix bugs in superimposing climatology !
71! seasonal cycle calculations !
72! aug 2011 - y-t hou fix a bug in subr getgases doing vertical !
73! co2 mapping. (for top_at_1 case, not affact opr). !
74! nov 2012 - y-t hou modified control parameters thru module !
75! 'physparam'. !
76! jan 2013 - z. janjic/y. hou modified ilon (longitude index) !
77! computing formula in subroutine getgases to work !
78! properly for models with either of 0->360 or !
79! -180->180 zonal grid directions. !
80! !
81! !
82!!!!! ========================================================== !!!!!
83!!!!! end descriptions !!!!!
84!!!!! ========================================================== !!!!!
85
86
114
118 use machine, only : kind_phys, kind_io4
119 use funcphys, only : fpkapx
120 use module_iounitdef, only : nio3clm, nico2cn
121!
122 implicit none
123!
124 private
125
126! --- version tag and last revision date
127 character(40), parameter :: &
128 & VTAGGAS='NCEP-Radiation_gases v5.1 Nov 2012 '
129! & VTAGGAS='NCEP-Radiation_gases v5.0 Aug 2012 '
130
131 integer, parameter, public :: nf_vgas = 10 ! number of gas species
132 integer, parameter :: imxco2 = 24 ! input CO2 data longitude points
133 integer, parameter :: jmxco2 = 12 ! input CO2 data latitude points
134 integer, parameter :: minyear = 1957 ! earlist year 2D CO2 data available
135
136 real (kind=kind_phys), parameter :: resco2=15.0 ! horizontal resolution in degree
137 real (kind=kind_phys), parameter :: prsco2=788.0 ! pressure limitation for 2D CO2 (mb)
138 real (kind=kind_phys) :: raddeg ! rad->deg conversion
139 real (kind=kind_phys) :: hfpi ! half of pi
140
141 real (kind=kind_phys), parameter :: co2vmr_def = 350.0e-6 ! parameter constant for CO2 volume mixing ratio
142 real (kind=kind_phys), parameter :: n2ovmr_def = 0.31e-6 ! parameter constant for N2O volume mixing ratio
143 real (kind=kind_phys), parameter :: ch4vmr_def = 1.50e-6 ! parameter constant for CH4 volume mixing ratio
144 real (kind=kind_phys), parameter :: o2vmr_def = 0.209 ! parameter constant for O2 volume mixing ratio
145 real (kind=kind_phys), parameter :: covmr_def = 1.50e-8 ! parameter constant for CO colume mixing ratio
146! aer 2003 value
147 real (kind=kind_phys), parameter :: f11vmr_def = 3.520e-10
148! aer 2003 value
149 real (kind=kind_phys), parameter :: f12vmr_def = 6.358e-10
150! aer 2003 value
151 real (kind=kind_phys), parameter :: f22vmr_def = 1.500e-10
152! aer 2003 value
153 real (kind=kind_phys), parameter :: cl4vmr_def = 1.397e-10
154! gfdl 1999 value
155 real (kind=kind_phys), parameter :: f113vmr_def= 8.2000e-11
156
157! --- module variables to be set in subroutin gas_init and/or gas_update
158
159! arrays for co2 2-d monthly data and global mean values from observed data
160
161 real (kind=kind_phys), allocatable :: co2vmr_sav(:,:,:)
162 real (kind=kind_phys), allocatable :: co2cyc_sav(:,:,:)
163
164 real (kind=kind_phys) :: co2_glb = co2vmr_def
165 real (kind=kind_phys) :: gco2cyc(12)
166 data gco2cyc(:) / 12*0.0 /
167
168 integer :: kyrsav = 0
169 integer :: kmonsav = 1
170
171! --- public interfaces
172
174
175
176! =================
177 contains
178! =================
179
190!-----------------------------------
191 subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, &
192 & ictmflg, con_pi, errflg, errmsg)
193
194! =================================================================== !
195! !
196! gas_init sets up co2, etc. parameters. !
197! !
198! inputs: !
199! me - print message control flag !
200! ico2flg - co2 data source control flag !
201! =0: use prescribed co2 global mean value !
202! =1: use input global mean co2 value (co2_glb) !
203! =2: use input 2-d monthly co2 value (co2vmr_sav) !
204! ictmflg - =yyyy#, data ic time/date control flag !
205! =-2: same as 0, but superimpose seasonal cycle !
206! from climatology data set. !
207! =-1: use user provided external data for the fcst !
208! time, no extrapolation. !
209! =0: use data at initial cond time, if not existed !
210! then use latest, without extrapolation. !
211! =1: use data at the forecast time, if not existed !
212! then use latest and extrapolate to fcst time. !
213! =yyyy0: use yyyy data for the forecast time, no !
214! further data extrapolation. !
215! =yyyy1: use yyyy data for the fcst. if needed, do !
216! extrapolation to match the fcst time. !
217! co2usr_file - external co2 user defined data table !
218! co2cyc_file - external co2 climotology monthly cycle data table !
219! con_pi - physical constant Pi !
220! !
221! outputs: (CCPP error handling) !
222! errflg - error flag !
223! errmsg - error message !
224! !
225! usage: call gas_init !
226! !
227! subprograms called: none !
228! !
229! =================================================================== !
230!
231 implicit none
232
233! --- inputs:
234 integer, intent(in) :: me, ictmflg, ico2flg
235 character(len=26),intent(in) :: co2usr_file,co2cyc_file
236 real(kind=kind_phys), intent(in) :: con_pi
237
238! --- output:
239 character(len=*), intent(out) :: errmsg
240 integer, intent(out) :: errflg
241
242! --- locals:
243 real (kind=kind_phys), dimension(IMXCO2,JMXCO2) :: co2dat
244 real (kind=kind_phys) :: co2g1, co2g2
245
246 integer :: i, j, k, iyr, imo
247 logical :: file_exist, lextpl
248 character :: cline*100, cform*8
249 data cform / '(24f7.2)' / !! data format in IMXCO2*f7.2
250!
251!===> ... begin here
252!
253
254! Initialize the CCPP error handling variables
255 errmsg = ''
256 errflg = 0
257
258! Initiailize module parameters
259 raddeg = 180.0/con_pi
260 hfpi = 0.5*con_pi
261
262 if ( me == 0 ) print *, vtaggas ! print out version tag
263
264 kyrsav = 0
265 kmonsav = 1
266
267! --- ... co2 data section
268
270
271 lab_ico2 : if ( ico2flg == 0 ) then
272
273 if ( me == 0 ) then
274 print *,' - Using prescribed co2 global mean value=', &
275 & co2vmr_def
276 endif
277
278 else lab_ico2
279
280 lab_ictm : if ( ictmflg == -1 ) then ! input user provided data
281
282 inquire (file=co2usr_file, exist=file_exist)
283 if ( .not. file_exist ) then
284 print *,' Can not find user CO2 data file: ',co2usr_file
285 errflg = 1
286 errmsg = 'ERROR(gas_init): Can not find user CO2 data file'
287 return
288 else
289 close (nico2cn)
290 open(nico2cn,file=co2usr_file,form='formatted',status='old')
291 rewind nico2cn
292 read (nico2cn, 25) iyr, cline, co2g1, co2g2
293 25 format(i4,a94,f7.2,16x,f5.2)
294 co2_glb = co2g1 * 1.0e-6
295
296 if ( ico2flg == 1 ) then
297 if ( me == 0 ) then
298 print *,' - Using co2 global annual mean value from', &
299 & ' user provided data set:',co2usr_file
300 print *, iyr,cline(1:94),co2g1,' GROWTH RATE =', co2g2
301 endif
302 elseif ( ico2flg == 2 ) then
303 allocate ( co2vmr_sav(imxco2,jmxco2,12) )
304
305 do imo = 1, 12
306 read (nico2cn,cform) co2dat
307!check print cform, co2dat
308
309 do j = 1, jmxco2
310 do i = 1, imxco2
311 co2vmr_sav(i,j,imo) = co2dat(i,j) * 1.0e-6
312 enddo
313 enddo
314 enddo
315
316 if ( me == 0 ) then
317 print *,' - Using co2 monthly 2-d data from user', &
318 & ' provided data set:',co2usr_file
319 print *, iyr,cline(1:94),co2g1,' GROWTH RATE =', co2g2
320
321 print *,' CHECK: Sample of selected months of CO2 data'
322 do imo = 1, 12, 3
323 print *,' Month =',imo
324 print *, (co2vmr_sav(1,j,imo),j=1,jmxco2)
325 enddo
326 endif
327 else
328 print *,' ICO2=',ico2flg,' is not a valid selection'
329 errflg = 1
330 errmsg = 'ERROR(gas_init): ICO2 is not valid'
331 return
332 endif ! endif_ico2flg_block
333
334 close (nico2cn)
335 endif ! endif_file_exist_block
336
337 else lab_ictm ! input from observed data
338
339 if ( ico2flg == 1 ) then
340 if ( me == 0 ) then
341 print *,' - Using observed co2 global annual mean value'
342 endiF
343 elseif ( ico2flg == 2 ) then
344 allocate ( co2vmr_sav(imxco2,jmxco2,12) )
345
346 if ( me == 0 ) then
347 print *,' - Using observed co2 monthly 2-d data'
348 endif
349 else
350 print *,' ICO2=',ico2flg,' is not a valid selection'
351 errflg = 1
352 errmsg = 'ERROR(gas_init): ICO2 is not valid'
353 return
354 endif
355
356 if ( ictmflg == -2 ) then
357 inquire (file=co2cyc_file, exist=file_exist)
358 if ( .not. file_exist ) then
359 if ( me == 0 ) then
360 print *,' Can not find seasonal cycle CO2 data: ', &
361 & co2cyc_file
362 endif
363 errflg = 1
364 errmsg = 'ERROR(gas_init): Can not find seasonal cycle '//&
365 & 'CO2 data'
366 return
367 else
368 allocate( co2cyc_sav(imxco2,jmxco2,12) )
369
370! --- ... read in co2 2-d seasonal cycle data
371 close (nico2cn)
372 open (nico2cn,file=co2cyc_file,form='formatted', &
373 & status='old')
374 rewind nico2cn
375 read (nico2cn, 35) cline, co2g1, co2g2
376 35 format(a98,f7.2,16x,f5.2)
377 read (nico2cn,cform) co2dat ! skip annual mean part
378
379 if ( me == 0 ) then
380 print *,' - Superimpose seasonal cycle to mean CO2 data'
381 print *,' Opened CO2 climatology seasonal cycle data',&
382 & ' file: ',co2cyc_file
383!check print *, cline(1:98), co2g1, co2g2
384 endif
385
386 do imo = 1, 12
387 read (nico2cn,45) cline, gco2cyc(imo)
388 45 format(a58,f7.2)
389!check print *, cline(1:58),gco2cyc(imo)
390 gco2cyc(imo) = gco2cyc(imo) * 1.0e-6
391
392 read (nico2cn,cform) co2dat
393!check print cform, co2dat
394 do j = 1, jmxco2
395 do i = 1, imxco2
396 co2cyc_sav(i,j,imo) = co2dat(i,j) * 1.0e-6
397 enddo
398 enddo
399 enddo
400
401 close (nico2cn)
402 endif ! endif_file_exist_block
403 endif
404
405 endif lab_ictm
406 endif lab_ico2
407
408 return
409!
410!...................................
411 end subroutine gas_init
412!-----------------------------------
413
429!-----------------------------------
430 subroutine gas_update(iyear, imon, iday, ihour, ldoco2, &
431 & me, co2dat_file, co2gbl_file, ictmflg, ico2flg, &
432 & errflg, errmsg )
433
434! =================================================================== !
435! !
436! gas_update reads in 2-d monthly co2 data set for a specified year. !
437! data are in a 15 degree lat/lon horizontal resolution. !
438! !
439! inputs: dimemsion !
440! iyear - year of the requested data for fcst 1 !
441! imon - month of the year 1 !
442! iday - day of the month 1 !
443! ihour - hour of the day 1 !
444! ldoco2 - co2 update control flag 1 !
445! me - print message control flag 1 !
446! ico2flg - co2 data source control flag !
447! =0: use prescribed co2 global mean value !
448! =1: use input global mean co2 value (co2_glb) !
449! =2: use input 2-d monthly co2 value (co2vmr_sav) !
450! ictmflg - =yyyy#, data ic time/date control flag !
451! =-2: same as 0, but superimpose seasonal cycle !
452! from climatology data set. !
453! =-1: use user provided external data for the fcst !
454! time, no extrapolation. !
455! =0: use data at initial cond time, if not existed !
456! then use latest, without extrapolation. !
457! =1: use data at the forecast time, if not existed !
458! then use latest and extrapolate to fcst time. !
459! =yyyy0: use yyyy data for the forecast time, no !
460! further data extrapolation. !
461! =yyyy1: use yyyy data for the fcst. if needed, do !
462! extrapolation to match the fcst time. !
463! ivflip - vertical profile indexing flag !
464! co2dat_file - external co2 2d monthly obsv data table !
465! co2gbl_file - external co2 global annual mean data table !
466! !
467! outputs: (CCPP error handling) !
468! errflg - error flag !
469! errmsg - error message !
470! !
471! internal module variables: !
472! co2vmr_sav - monthly co2 volume mixing ratio IMXCO2*JMXCO2*12 !
473! co2cyc_sav - monthly cycle co2 vol mixing ratio IMXCO2*JMXCO2*12 !
474! co2_glb - global annual mean co2 mixing ratio !
475! gco2cyc - global monthly mean co2 variation 12 !
476! !
477! usage: call gas_update !
478! !
479! subprograms called: none !
480! !
481! =================================================================== !
482!
483 implicit none
484
485! --- inputs:
486 integer, intent(in) :: iyear,imon,iday,ihour,me,ictmflg,ico2flg
487 character(len=26),intent(in) :: co2dat_file, co2gbl_file
488 logical, intent(in) :: ldoco2
489
490! --- output:
491 character(len=*), intent(out) :: errmsg
492 integer, intent(out) :: errflg
493
494! --- locals:
495 real (kind=kind_phys), dimension(IMXCO2,JMXCO2) :: co2dat, co2ann
496 real (kind=kind_phys) :: co2g1, co2g2, rate
497
498 integer :: i, id, j, l, iyr, imo, iyr1, iyr2, jyr, idyr
499 integer, save :: mdays(13), midmon=15, midm=15, midp=45
500! --- number of days in a month
501 data mdays / 31,28,31,30,31,30,31,31,30,31,30,31,30 /
502
503 logical :: file_exist, lextpl, change
504 character :: cline*100, cform*8, cfile1*26
505 data cform / '(24f7.2)' / !! data format in IMXCO2*f7.2
506!
507!===> ... begin here
508!
509! Initialize the CCPP error handling variables
510 errmsg = ''
511 errflg = 0
512
514
515 if ( ico2flg == 0 ) return ! use prescribed global mean co2 data
516 if ( ictmflg ==-1 ) return ! use user provided co2 data
517 if ( .not. ldoco2 ) return ! no need to update co2 data
518
519 if ( ictmflg < 0 ) then ! use user provided external data
520 lextpl = .false. ! no time extrapolation
521 idyr = iyear ! use the model year
522 else ! use historically observed data
523 lextpl = ( mod(ictmflg,10) == 1 ) ! flag for data extrapolation
524 idyr = ictmflg / 10 ! year of data source used
525 if ( idyr == 0 ) idyr = iyear ! not specified, use model year
526 endif
527
528! --- ... auto select co2 2-d data table for required year
529
530 kmonsav = imon
531 if ( kyrsav == iyear ) return
532 kyrsav = iyear
533 iyr = iyear
534
535! --- ... for data earlier than MINYEAR (1957), the data are in
536! the form of semi-yearly global mean values. otherwise,
537! data are monthly mean in horizontal 2-d map.
538
539 lab_if_idyr : if ( idyr < minyear .and. ictmflg > 0 ) then
540
541 if ( me == 0 ) then
542 print *,' Requested CO2 data year',iyear,' earlier than', &
543 & minyear
544 print *,' Which is the earliest monthly observation', &
545 & ' data available.'
546 print *,' Thus, historical global mean data is used'
547 endif
548
549! --- ... check to see if requested co2 data file existed
550
551 inquire (file=co2gbl_file, exist=file_exist)
552 if ( .not. file_exist ) then
553 print *,' Requested co2 data file "',co2gbl_file, &
554 & '" not found'
555 errflg = 1
556 errmsg = 'ERROR(gas_update): Requested co2 data file not '// &
557 & 'found'
558 return
559 else
560 close(nico2cn)
561 open (nico2cn,file=co2gbl_file,form='formatted',status='old')
562 rewind nico2cn
563
564 read (nico2cn, 24) iyr1, iyr2, cline
565 24 format(i4,4x,i4,a48)
566
567 if ( me == 0 ) then
568 print *,' Opened co2 data file: ',co2gbl_file
569!check print *, iyr1, iyr2, cline(1:48)
570 endif
571
572 if ( idyr < iyr1 ) then
573 iyr = iyr1
574!check if ( me == 0 ) then
575! print *,' Using earlist available co2 data, year=',iyr1
576!check endif
577 endif
578
579 i = iyr2
580 lab_dowhile1 : do while ( i >= iyr1 )
581! read (NICO2CN,26) jyr, co2g1, co2g2
582! 26 format(i4,4x,2f7.2)
583 read (nico2cn, *) jyr, co2g1, co2g2
584
585 if ( i == iyr .and. iyr == jyr ) then
586 co2_glb = (co2g1+co2g2) * 0.5e-6
587 if ( ico2flg == 2 ) then
588 do j = 1, jmxco2
589 do i = 1, imxco2
590 co2vmr_sav(i,j,1:6) = co2g1 * 1.0e-6
591 co2vmr_sav(i,j,7:12) = co2g2 * 1.0e-6
592 enddo
593 enddo
594 endif
595
596 if ( me == 0 ) print *,' Co2 data for year',iyear, &
597 & co2_glb
598 exit lab_dowhile1
599 else
600!check if ( me == 0 ) print *,' Skip co2 data for year',i
601 i = i - 1
602 endif
603 enddo lab_dowhile1
604
605 close ( nico2cn )
606 endif ! end if_file_exist_block
607
608 else lab_if_idyr
609
610! --- ... set up input data file name
611
612 cfile1 = co2dat_file
613 write(cfile1(19:22),34) idyr
614 34 format(i4.4)
615
616! --- ... check to see if requested co2 data file existed
617
618 inquire (file=cfile1, exist=file_exist)
619 if ( .not. file_exist ) then
620
621 lab_if_ictm : if ( ictmflg > 10 ) then ! specified year of data not found
622 if ( me == 0 ) then
623 print *,' Specified co2 data for year',idyr, &
624 & ' not found !! Need to change namelist ICTM !!'
625 endif
626 errflg = 1
627 errmsg = 'ERROR(gas_update): Specified co2 data for year '//&
628 & 'not found'
629 return
630 else lab_if_ictm ! looking for latest available data
631 if ( me == 0 ) then
632 print *,' Requested co2 data for year',idyr, &
633 & ' not found, check for other available data set'
634 endif
635
636 lab_dowhile2 : do while ( iyr >= minyear )
637 iyr = iyr - 1
638 write(cfile1(19:22),34) iyr
639
640 inquire (file=cfile1, exist=file_exist)
641 if ( me == 0 ) then
642 print *,' Looking for CO2 file ',cfile1
643 endif
644
645 if ( file_exist ) then
646 exit lab_dowhile2
647 endif
648 enddo lab_dowhile2
649
650 if ( .not. file_exist ) then
651 if ( me == 0 ) then
652 print *,' Can not find co2 data source file'
653 endif
654 errflg = 1
655 errmsg = 'ERROR(gas_update): Can not find co2 data '// &
656 & 'source file'
657 return
658 endif
659 endif lab_if_ictm
660 endif ! end if_file_exist_block
661
662! --- ... read in co2 2-d data for the requested month
663
664 close(nico2cn)
665 open (nico2cn,file=cfile1,form='formatted',status='old')
666 rewind nico2cn
667 read (nico2cn, 36) iyr, cline, co2g1, co2g2
668 36 format(i4,a94,f7.2,16x,f5.2)
669
670 if ( me == 0 ) then
671 print *,' Opened co2 data file: ',cfile1
672 print *, iyr, cline(1:94), co2g1,' GROWTH RATE =', co2g2
673 endif
674
675! --- ... add growth rate if needed
676 if ( lextpl ) then
677! rate = co2g2 * (iyear - iyr) ! rate from early year
678! rate = 1.60 * (iyear - iyr) ! avg rate over long period
679 rate = 2.00 * (iyear - iyr) ! avg rate for recent period
680 else
681 rate = 0.0
682 endif
683
684 co2_glb = (co2g1 + rate) * 1.0e-6
685 if ( me == 0 ) then
686 print *,' Global annual mean CO2 data for year', &
687 & iyear, co2_glb
688 endif
689
690 if ( ictmflg == -2 ) then ! need to calc ic time annual mean first
691
692 if ( ico2flg == 1 ) then
693 if ( me==0 ) then
694 print *,' CHECK: Monthly deviations of climatology ', &
695 & 'to be superimposed on global annual mean'
696 print *, gco2cyc
697 endif
698 elseif ( ico2flg == 2 ) then
699 co2ann(:,:) = 0.0
700
701 do imo = 1, 12
702 read (nico2cn,cform) co2dat
703!check print cform, co2dat
704
705 do j = 1, jmxco2
706 do i = 1, imxco2
707 co2ann(i,j) = co2ann(i,j) + co2dat(i,j)
708 enddo
709 enddo
710 enddo
711
712 do j = 1, jmxco2
713 do i = 1, imxco2
714 co2ann(i,j) = co2ann(i,j) * 1.0e-6 / float(12)
715 enddo
716 enddo
717
718 do imo = 1, 12
719 do j = 1, jmxco2
720 do i = 1, imxco2
721 co2vmr_sav(i,j,imo) = co2ann(i,j)+co2cyc_sav(i,j,imo)
722 enddo
723 enddo
724 enddo
725
726 if ( me==0 ) then
727 print *,' CHECK: Sample of 2-d annual mean of CO2 ', &
728 & 'data used for year:',iyear
729 print *, co2ann(1,:)
730 print *,' CHECK: AFTER adding seasonal cycle, Sample ', &
731 & 'of selected months of CO2 data for year:',iyear
732 do imo = 1, 12, 3
733 print *,' Month =',imo
734 print *, co2vmr_sav(1,:,imo)
735 enddo
736 endif
737 endif ! endif_icl2flg_block
738
739 else ! no need to calc ic time annual mean first
740
741 if ( ico2flg == 2 ) then ! directly save monthly data
742 do imo = 1, 12
743 read (nico2cn,cform) co2dat
744!check print cform, co2dat
745
746 do j = 1, jmxco2
747 do i = 1, imxco2
748 co2vmr_sav(i,j,imo) = (co2dat(i,j) + rate) * 1.0e-6
749 enddo
750 enddo
751 enddo
752
753 if ( me == 0 ) then
754 print *,' CHECK: Sample of selected months of CO2 ', &
755 & 'data used for year:',iyear
756 do imo = 1, 12, 3
757 print *,' Month =',imo
758 print *, co2vmr_sav(1,:,imo)
759 enddo
760 endif
761 endif ! endif_ico2flg_block
762
763 do imo = 1, 12
764 gco2cyc(imo) = 0.0
765 enddo
766 endif ! endif_ictmflg_block
767 close ( nico2cn )
768
769 endif lab_if_idyr
770
771 return
772!
773!...................................
774 end subroutine gas_update
775!-----------------------------------
776
809!-----------------------------------
810 subroutine getgases( plvl, xlon, xlat, IMAX, LMAX, ico2flg, &
811 & top_at_1, con_pi, gasdat)
812! =================================================================== !
813! !
814! getgases set up global distribution of radiation absorbing gases !
815! in volume mixing ratio. currently only co2 has the options from !
816! observed values, all other gases are asigned to the climatological !
817! values. !
818! !
819! inputs: !
820! plvl(IMAX,LMAX+1)- pressure at model layer interfaces (mb) !
821! xlon(IMAX) - grid longitude in radians, ok both 0->2pi or !
822! -pi -> +pi arrangements !
823! xlat(IMAX) - grid latitude in radians, default range to !
824! pi/2 -> -pi/2, otherwise see in-line comment !
825! IMAX, LMAX - horiz, vert dimensions for output data !
826! ico2flg - co2 data source control flag !
827! =0: use prescribed co2 global mean value !
828! =1: use input global mean co2 value (co2_glb) !
829! =2: use input 2-d monthly co2 value (co2vmr_sav)!
830! top_at_1 - vertical profile indexing flag !
831! con_pi - physical constant Pi !
832! !
833! outputs: !
834! gasdat(IMAX,LMAX,NF_VGAS) - gases volume mixing ratioes !
835! (:,:,1) - co2 !
836! (:,:,2) - n2o !
837! (:,:,3) - ch4 !
838! (:,:,4) - o2 !
839! (:,:,5) - co !
840! (:,:,6) - cfc11 !
841! (:,:,7) - cfc12 !
842! (:,:,8) - cfc22 !
843! (:,:,9) - ccl4 !
844! (:,:,10) - cfc113 !
845! !
846! note: for lower atmos co2vmr_sav may have clim monthly deviations !
847! superimposed on init-cond co2 value, while co2_glb only !
848! contains the global mean value, thus needs to add the !
849! monthly dglobal mean deviation gco2cyc at upper atmos. for !
850! ictmflg/=-2, this value will be zero. !
851! !
852! usage: call getgases !
853! !
854! subprograms called: none !
855! !
856! =================================================================== !
857!
858 implicit none
859
860! --- input:
861 integer, intent(in) :: imax, lmax, ico2flg
862 real (kind=kind_phys), intent(in) :: plvl(:,:), xlon(:), xlat(:)
863 logical, intent(in) :: top_at_1
864 real(kind=kind_phys), intent(in) :: con_pi
865
866! --- output:
867 real (kind=kind_phys), intent(out) :: gasdat(:,:,:)
868
869! --- local:
870 integer :: i, k, ilat, ilon
871
872 real (kind=kind_phys) :: xlon1, xlat1, tmp
873
874!===> ... begin here
875
876! --- ... assign default values
877
878 do k = 1, lmax
879 do i = 1, imax
880 gasdat(i,k,1) = co2vmr_def
881 gasdat(i,k,2) = n2ovmr_def
882 gasdat(i,k,3) = ch4vmr_def
883 gasdat(i,k,4) = o2vmr_def
884 gasdat(i,k,5) = covmr_def
885 gasdat(i,k,6) = f11vmr_def
886 gasdat(i,k,7) = f12vmr_def
887 gasdat(i,k,8) = f22vmr_def
888 gasdat(i,k,9) = cl4vmr_def
889 gasdat(i,k,10)= f113vmr_def
890 enddo
891 enddo
892
893! --- ... co2 section
894
895 if ( ico2flg == 1 ) then
896! --- use obs co2 global annual mean value only
897
898 do k = 1, lmax
899 do i = 1, imax
900 gasdat(i,k,1) = co2_glb + gco2cyc(kmonsav)
901 enddo
902 enddo
903
904 elseif ( ico2flg == 2 ) then
905! --- use obs co2 monthly data with 2-d variation at lower atmos
906! otherwise use global mean value
907
908 tmp = raddeg / resco2
909 do i = 1, imax
910 xlon1 = xlon(i)
911 if ( xlon1 < 0.0 ) xlon1 = xlon1 + con_pi ! if xlon in -pi->pi, convert to 0->2pi
912 xlat1 = hfpi - xlat(i) ! if xlat in pi/2 -> -pi/2 range
913!note xlat1 = xlat(i) ! if xlat in 0 -> pi range
914
915 ilon = min( imxco2, int( xlon1*tmp + 1 ))
916 ilat = min( jmxco2, int( xlat1*tmp + 1 ))
917
918 if (top_at_1) then ! index from toa to sfc
919 do k = 1, lmax
920 if ( plvl(i,k) >= prsco2 ) then
921 gasdat(i,k,1) = co2vmr_sav(ilon,ilat,kmonsav)
922 else
923 gasdat(i,k,1) = co2_glb + gco2cyc(kmonsav)
924 endif
925 enddo
926 else ! index from sfc to toa
927 do k = 1, lmax
928 if ( plvl(i,k+1) >= prsco2 ) then
929 gasdat(i,k,1) = co2vmr_sav(ilon,ilat,kmonsav)
930 else
931 gasdat(i,k,1) = co2_glb + gco2cyc(kmonsav)
932 endif
933 enddo
934 endif
935 enddo
936 endif
937
938!
939 return
940!...................................
941 end subroutine getgases
942!-----------------------------------
943
944!
945!........................................!
946 end module module_radiation_gases !
948!========================================!
real(kind=kind_phys), parameter cl4vmr_def
real(kind=kind_phys) co2_glb
real(kind=kind_phys) raddeg
real(kind=kind_phys), parameter f11vmr_def
real(kind=kind_phys), parameter covmr_def
real(kind=kind_phys), dimension(:,:,:), allocatable co2cyc_sav
integer, parameter minyear
integer, parameter imxco2
real(kind=kind_phys), dimension(:,:,:), allocatable co2vmr_sav
real(kind=kind_phys), parameter co2vmr_def
real(kind=kind_phys) hfpi
real(kind=kind_phys), parameter f113vmr_def
real(kind=kind_phys), parameter n2ovmr_def
real(kind=kind_phys), parameter o2vmr_def
real(kind=kind_phys), parameter f12vmr_def
subroutine, public getgases(plvl, xlon, xlat, imax, lmax, ico2flg, top_at_1, con_pi, gasdat)
This subroutine sets up global distribution of radiation absorbing gases in volume mixing ratio....
subroutine, public gas_init(me, co2usr_file, co2cyc_file, ico2flg, ictmflg, con_pi, errflg, errmsg)
This subroutine sets up co2, etc. parameters.
integer, parameter jmxco2
real(kind=kind_phys), parameter ch4vmr_def
real(kind=kind_phys), parameter prsco2
real(kind=kind_phys), dimension(12) gco2cyc
subroutine, public gas_update(iyear, imon, iday, ihour, ldoco2, me, co2dat_file, co2gbl_file, ictmflg, ico2flg, errflg, errmsg)
This subroutine reads in 2-d monthly co2 data set for a specified year. Data are in a 15 degree lat/l...
real(kind=kind_phys), parameter f22vmr_def
real(kind=kind_phys), parameter resco2
integer, parameter, public nf_vgas
this module defines fortran unit numbers for input/output data files for the ncep gfs model.
Definition iounitdef.f:53
This module sets up constant gas rofiles, such as co2, ch4, n2o, o2, and those of cfc gases.