Changeset 1903 for trunk/LMDZ.TITAN/libf
- Timestamp:
- Jan 29, 2018, 11:41:36 PM (7 years ago)
- Location:
- trunk/LMDZ.TITAN/libf
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/lect_start_archive.F
r1898 r1903 5 5 6 6 ! USE surfdat_h 7 USE comchem_h, only : cnames 7 USE comchem_h, only : cnames, nkim 8 8 USE comchem_newstart_h 9 9 USE comsoil_h, ONLY: nsoilmx, layer, mlayer, volcapa, inertiedat … … 305 305 306 306 allocate(preskimold(nlaykimold)) 307 allocate(ykim_upS( 44,iip1,jjp1,nlaykimold))308 allocate(ykim_upoldS( 44,imold+1,jmold+1,nlaykimold))309 allocate(ykim_up_oldv( 44,ngrid,nlaykimold))307 allocate(ykim_upS(nkim,iip1,jjp1,nlaykimold)) 308 allocate(ykim_upoldS(nkim,imold+1,jmold+1,nlaykimold)) 309 allocate(ykim_up_oldv(nkim,ngrid,nlaykimold)) 310 310 311 311 allocate(var (imold+1,jmold+1,llm)) … … 879 879 880 880 ! Then read all the others by their name if needed 881 DO iq=2, 44881 DO iq=2,nkim 882 882 ierr=NF_INQ_VARID(nid,trim(cnames(iq))//"_up",nvarid) 883 883 IF (ierr .NE. NF_NOERR) THEN … … 1248 1248 1249 1249 ! Do the horizontal interpolation 1250 DO i=1, 441250 DO i=1,nkim 1251 1251 call interp_horiz(ykim_upoldS(i,:,:,:),ykim_upS(i,:,:,:), 1252 1252 & imold,jmold,iim,jjm,nlaykimold, -
trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/newstart.F
r1898 r1903 17 17 & is_master 18 18 use infotrac, only: infotrac_init, nqtot, tname 19 USE comchem_h, ONLY: n laykim_up, ykim_up19 USE comchem_h, ONLY: nkim, nlaykim_up, ykim_up 20 20 USE comchem_newstart_h 21 21 USE comsoil_h, ONLY: nsoilmx, layer, mlayer, inertiedat … … 1091 1091 1092 1092 IF (.NOT.allocated(ykim_up)) THEN 1093 ALLOCATE(ykim_up( 44,ngridmx,nlaykim_up))1093 ALLOCATE(ykim_up(nkim,ngridmx,nlaykim_up)) 1094 1094 ENDIF 1095 1095 … … 1100 1100 1101 1101 WRITE(*,*) " Warning, nlaykimold=", nlaykimold 1102 WRITE(*,*) ' which implies that a vertical regrid on upper1102 WRITE(*,*) ' which implies that a vertical regrid on upper 1103 1103 &chemistry fields will be performed. If the ceiling is lowered I 1104 & 1104 &will also adjust GCM uppermost layers chem. tracers.' 1105 1105 WRITE(*,*) 1106 1106 -
trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/start2archive.F
r1899 r1903 21 21 use infotrac, only: infotrac_init, nqtot, tname 22 22 USE comsoil_h 23 USE comchem_h, only : cnames, n laykim_up, preskim, ykim_up23 USE comchem_h, only : cnames, nkim, nlaykim_up, preskim, ykim_up 24 24 ! USE comgeomfi_h, ONLY: lati, long, area 25 25 ! use control_mod … … 234 234 . I presume they're all here as you can't do uncomplete chemistry!" 235 235 236 ALLOCATE(ykim_up( 44,ngridmx,nlaykim_up))237 ALLOCATE(ykim_upS( 44,ip1jmp1,nlaykim_up))236 ALLOCATE(ykim_up(nkim,ngridmx,nlaykim_up)) 237 ALLOCATE(ykim_upS(nkim,ip1jmp1,nlaykim_up)) 238 238 239 239 kim=.TRUE. … … 358 358 c qsurf --> qsurfS 359 359 c tankCH4 --> tankCH4S 360 c ykim_up --> ykim_upS ( 44 upper chemistry fields )360 c ykim_up --> ykim_upS ( nkim=44 upper chemistry fields ) 361 361 c 362 362 c----------------------------------------------------------------------- … … 372 372 373 373 IF (kim) THEN ! NB : fields are in comchem_startarch_h 374 DO iq=1, 44374 DO iq=1,nkim 375 375 call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,ykim_up(iq,:,:), 376 376 & ykim_upS(iq,:,:)) … … 523 523 c----------------------------------------------------------------- 524 524 c Ecriture des champs upper_chemistry 525 c NB : We assume a given order of the 44 chemistry tracers !526 c ( H=1, H2=2 ..., C4N2= 44) -> hardcoded in comchem_h.525 c NB : We assume a given order of the nkim=44 chemistry tracers ! 526 c ( H=1, H2=2 ..., C4N2=nkim=44) -> hardcoded in comchem_h. 527 527 c----------------------------------------------------------------- 528 528 529 529 IF (kim) THEN 530 DO iq=1, 44530 DO iq=1,nkim 531 531 call write_archive(nid,ntime,trim(cnames(iq))//'_up', 532 532 . trim(cnames(iq))//' in upper atmosphere', -
trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/vert_regrid_kim.F90
r1900 r1903 16 16 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 17 17 18 USE comchem_h, ONLY: cnames, nlaykim_up, preskim, ykim_up18 USE comchem_h, ONLY: nkim, nlaykim_up, preskim, ykim_up 19 19 USE comchem_newstart_h 20 20 USE tracer_h … … 64 64 lowered = .TRUE. 65 65 66 ALLOCATE(avg_qtop( 44,ngridmx))66 ALLOCATE(avg_qtop(nkim,ngridmx)) 67 67 68 DO ichem=1, 4468 DO ichem=1,nkim 69 69 avg_qtop(ichem,:)=0.0 70 70 DO ilon=1,iim … … 111 111 112 112 IF ( preskim(ln) .GT. preskimold(1) ) THEN 113 DO ichem=1, 44113 DO ichem=1,nkim 114 114 coef = ( preskim(ln)-aps(llm) ) / ( preskimold(1)-aps(llm) ) 115 115 ykim_up(ichem,:,ln) = (1.0-coef)*avg_qtop(ichem,:) + coef*ykim_up_oldv(ichem,:,1) … … 145 145 coef = ( aps(ilay) - preskim(1) ) / ( aps(isup) - preskim(1) ) 146 146 147 DO ichem=1, 44147 DO ichem=1,nkim 148 148 149 149 ! We need to convert ykim_up on phys grid to q on dyn grid … … 174 174 175 175 ENDDO ! do ilat=2,jjm 176 ENDDO ! do ichem=1, 44176 ENDDO ! do ichem=1,nkim 177 177 ENDDO ! do ilay=1,llm 178 178 -
trunk/LMDZ.TITAN/libf/phytitan/calchim.F90
r1795 r1903 1 SUBROUTINE calchim(n lon,ny,qy_c,nomqy_c,declin_rad,ls_rad, &2 dtchim,ctemp,cplay,cplev,czlay,czlev,dqyc ,NLEV)1 SUBROUTINE calchim(ngrid,qy_c,declin_rad,ls_rad, & 2 dtchim,ctemp,cplay,cplev,czlay,czlev,dqyc) 3 3 4 4 !-------------------------------------------------------------------- … … 17 17 ! 18 18 19 use comchem_h 19 20 use dimphy 20 21 21 use datafile_mod, only: datadir 22 23 22 use comcstfi_mod, only: rad, pi, kbol 24 23 use moyzon_mod, only: tmoy,playmoy,zlaymoy,zlevmoy,klat … … 27 26 implicit none 28 27 29 ! Parameters ( dans common_mod in old titan) 30 ! + doivent etre en accord avec titan.h 31 ! ------------------------------------------------- 32 33 INTEGER,PARAMETER :: NC = 44 ! Nb de composes dans la chimie 34 INTEGER,PARAMETER :: ND = 54 ! Nb de photodissociations 35 INTEGER,PARAMETER :: NR = 377 ! Nb de reactions dans la chimie 36 INTEGER,PARAMETER :: NLRT = 650 ! Pour l'UV 650 niveaux de 2 km 37 38 ! Dummy parameters without microphysics 39 ! + Just here to keep the whole stuff running without modif C sources 40 ! --------------------------------------------------------------------- 41 42 INTEGER :: utilaer(16) 43 INTEGER :: aerprod = 0 44 INTEGER :: htoh2 = 0 45 28 ! ------------------------------------------ 29 ! *********** 0. Declarations ************* 30 ! ------------------------------------------ 31 46 32 ! Arguments 47 33 ! --------- 48 34 49 INTEGER nlon ! nb of horiz points 50 INTEGER ny ! nb de composes (nqmax-nmicro) 51 REAL*8 qy_c(nlon,klev,NC) ! Especes chimiques apres adv.+diss. 52 character*10 nomqy_c(NC+1) ! Noms des especes chimiques 35 INTEGER ngrid ! nb of horiz points 36 REAL*8 qy_c(ngrid,klev,nkim) ! Especes chimiques apres adv.+diss. 53 37 REAL*8 declin_rad,ls_rad ! declinaison et long solaire en radians 54 38 REAL*8 dtchim ! pas de temps chimie 55 REAL*8 ctemp(nlon,klev) ! Temperature 56 REAL*8 cplay(nlon,klev) ! pression (Pa) 57 REAL*8 cplev(nlon,klev+1) ! pression intercouches (Pa) 58 REAL*8 czlay(nlon,klev) ! altitude (m) 59 REAL*8 czlev(nlon,klev+1) ! altitude intercouches (m) 60 61 REAL*8 dqyc(nlon,klev,NC) ! Tendances especes chimiques 62 63 INTEGER NLEV ! nbp_lev+70 - a changer si =/ 55 layers ? 39 REAL*8 ctemp(ngrid,klev) ! Temperature 40 REAL*8 cplay(ngrid,klev) ! pression (Pa) 41 REAL*8 cplev(ngrid,klev+1) ! pression intercouches (Pa) 42 REAL*8 czlay(ngrid,klev) ! altitude (m) 43 REAL*8 czlev(ngrid,klev+1) ! altitude intercouches (m) 44 45 REAL*8 dqyc(ngrid,klev,nkim) ! Tendances especes chimiques 46 64 47 65 48 ! Local variables : … … 70 53 ! variables envoyees dans la chimie: double precision 71 54 72 REAL*8 temp_c( NLEV)73 REAL*8 press_c( NLEV) ! T,p(mbar) a 1 lat donnee74 REAL*8 cqy( NLEV,NC) ! frac mol qui seront modifiees75 REAL*8 cqy0( NLEV,NC) ! frac mol avant modif76 REAL*8 surfhaze( NLEV)77 REAL*8 cprodaer( NLEV,4),cmaer(NLEV,4)78 REAL*8 ccsn( NLEV,4),ccsh(NLEV,4)55 REAL*8 temp_c(nlaykim_tot) 56 REAL*8 press_c(nlaykim_tot) ! T,p(mbar) a 1 lat donnee 57 REAL*8 cqy(nlaykim_tot,nkim) ! frac mol qui seront modifiees 58 REAL*8 cqy0(nlaykim_tot,nkim) ! frac mol avant modif 59 REAL*8 surfhaze(nlaykim_tot) 60 REAL*8 cprodaer(nlaykim_tot,4),cmaer(nlaykim_tot,4) 61 REAL*8 ccsn(nlaykim_tot,4),ccsh(nlaykim_tot,4) 79 62 ! rmil: milieu de couche, grille pour K,D,p,ct,T,y 80 63 ! rinter: intercouche (grille RA dans la chimie) 81 REAL*8 rmil( NLEV),rinter(NLEV),nb(NLEV)64 REAL*8 rmil(nlaykim_tot),rinter(nlaykim_tot),nb(nlaykim_tot) 82 65 REAL*8,save,allocatable :: kedd(:) 83 66 84 REAL*8 a,b85 67 character str1*1,str2*2 86 REAL*8 latit87 character*20 formt1,formt2,formt388 68 89 69 ! variables locales initialisees au premier appel … … 97 77 real*8 factalt,factdec,krpddec,krpddecp1,krpddecm1 98 78 real*8 duree 99 REAL*8,save :: mass( NC)79 REAL*8,save :: mass(nkim) 100 80 REAL*8,save,allocatable :: md(:,:) 101 81 REAL*8,save :: botCH4 … … 103 83 real*8,save :: r1d(131),ct1d(131),p1d(131),t1d(131) ! lecture tcp.ver 104 84 REAL*8,save,allocatable :: krpd(:,:,:,:),krate(:,:) 105 integer,save :: reactif(5, NR),nom_prod(NC),nom_perte(NC)106 integer,save :: prod(200, NC),perte(2,200,NC)107 character dummy*30,fich*7,ficdec*15,curdec*15,name*1085 integer,save :: reactif(5,nr_kim),nom_prod(nkim),nom_perte(nkim) 86 integer,save :: prod(200,nkim),perte(2,200,nkim) 87 character fich*7,ficdec*15,curdec*15,name*10 108 88 real*8 ficalt,oldq,newq,zalt 109 89 logical okfic 110 90 91 ! Dummy parameters without microphysics 92 ! + Just here to keep the whole stuff running without modif C sources 93 ! --------------------------------------------------------------------- 94 95 INTEGER :: utilaer(16) 96 INTEGER :: aerprod = 0 97 INTEGER :: htoh2 = 0 111 98 112 99 !----------------------------------------------------------------------- … … 127 114 ! ************************************ 128 115 129 allocate(kedd(NLEV)) 130 131 allocate(krpd(15,ND+1,NLRT,nbp_lat),krate(NLEV,NR),md(NLEV,NC)) 132 133 ! Verification du nombre de composes: coherence common_mod et nqmax-nmicro 134 ! ---------------------------------- 135 136 if (ny.ne.NC) then 137 print*,'PROBLEME de coherence dans le nombre de composes:',ny,NC 138 STOP 139 endif 116 allocate(kedd(nlaykim_tot)) 117 118 allocate(krpd(15,nd_kim+1,nlrt_kim,nbp_lat),krate(nlaykim_tot,nr_kim),md(nlaykim_tot,nkim)) 119 140 120 141 121 ! calcul de temp_c, densites et press_c en moyenne planetaire : … … 157 137 rinter(klev+1)=(zlevmoy(klev+1)+rad)/1000. 158 138 159 ! au-dessus du GCM, dr regulier et rinter( NLEV)=1290+2575 km.160 do l=klev+2, NLEV139 ! au-dessus du GCM, dr regulier et rinter(nlaykim_tot)=1290+2575 km. 140 do l=klev+2,nlaykim_tot 161 141 rinter(l) = rinter(klev+1) & 162 + (l-klev-1)*(3865.-rinter(klev+1))/( NLEV-klev-1)142 + (l-klev-1)*(3865.-rinter(klev+1))/(nlaykim_tot-klev-1) 163 143 rmil(l-1) = (rinter(l-1)+rinter(l))/2. 164 144 enddo 165 rmil( NLEV) = rinter(NLEV)+(rinter(NLEV)-rinter(NLEV-1))/2.145 rmil(nlaykim_tot) = rinter(nlaykim_tot)+(rinter(nlaykim_tot)-rinter(nlaykim_tot-1))/2. 166 146 ! rmil et rinter ne servent que pour la diffusion (> plafond-100km) donc ok en moyenne planetaire 167 147 … … 169 149 ! remplissage r1d,t1d,ct1d,p1d 170 150 open(11,file=TRIM(datadir)//'/tcp.ver',status='old') 171 read(11,*) dummy151 read(11,*) 172 152 do i=1,131 173 153 read(11,*) r1d(i),t1d(i),ct1d(i),p1d(i) … … 176 156 close(11) 177 157 178 ! extension pour klev+1 a NLEVavec tcp.ver158 ! extension pour klev+1 a nlaykim_tot avec tcp.ver 179 159 ! la jonction klev/klev+1 est brutale... Tant pis ? 180 160 ialt=1 181 do l=klev+1, NLEV161 do l=klev+1,nlaykim_tot 182 162 zalt=rmil(l)-rad/1000. 183 163 do i=ialt,130 … … 200 180 call comp(nomqy_c,nb,temp_c,mass,md) 201 181 print*,' Mass' 202 do ic=1, NC182 do ic=1,nkim 203 183 print*,nomqy_c(ic),mass(ic) 204 184 ! if(nomqy_c(ic).eq.'CH4') print*,"MD=",md(:,ic) … … 214 194 nom_perte,nom_prod,perte,prod) 215 195 ! print*,'nom_prod, nom_perte:' 216 ! do ic=1, NC196 ! do ic=1,nkim 217 197 ! print*,nom_prod(ic),nom_perte(ic) 218 198 ! enddo 219 199 ! print*,'premieres prod, perte(1:reaction,2:compagnon):' 220 ! do ic=1, NC200 ! do ic=1,nkim 221 201 ! print*,prod(1,ic),perte(1,1,ic),perte(2,1,ic) 222 202 ! enddo … … 224 204 ! l = klev-3 225 205 ! print*,'krate a p=',press_c(l),' reactifs et produits:' 226 ! do ic=1, ND+1206 ! do ic=1,nd_kim+1 227 207 ! print*,ic,krpd(7,ic,l,4)*nb(l)," ", 228 208 ! . nomqy_c(reactif(1,ic)+1), … … 230 210 ! . nomqy_c(reactif(4,ic)+1),nomqy_c(reactif(5,ic)+1) 231 211 ! enddo 232 ! do ic= ND+2,NR212 ! do ic=nd_kim+2,nr_kim 233 213 ! print*,ic,krate(l,ic)," ", 234 214 ! . nomqy_c(reactif(1,ic)+1), … … 245 225 kedd(:) = 5e2 ! valeur mise par defaut 246 226 ! UNITE ? doit etre ok pour gptitan 247 do l=1, NLEV227 do l=1,nlaykim_tot 248 228 zalt=rmil(l)-rad/1000. ! z en km 249 229 if ((zalt.ge.250.).and.(zalt.le.400.)) then … … 280 260 ! * Permet de faire le calcul une seule fois par lat 281 261 ! 282 DO j=1,n lon262 DO j=1,ngrid 283 263 284 264 if (j.eq.1) then … … 305 285 rinter(klev+1)=(rad+czlev(j,klev+1))/1000. 306 286 307 ! au-dessus du GCM, dr regulier et rinter( NLEV)=1290+2575 km.308 do l=klev+2, NLEV287 ! au-dessus du GCM, dr regulier et rinter(nlaykim_tot)=1290+2575 km. 288 do l=klev+2,nlaykim_tot 309 289 rinter(l) = rinter(klev+1) & 310 + (l-klev-1)*(3865.-rinter(klev+1))/( NLEV-klev-1)290 + (l-klev-1)*(3865.-rinter(klev+1))/(nlaykim_tot-klev-1) 311 291 rmil(l-1) = (rinter(l-1)+rinter(l))/2. 312 292 enddo 313 rmil( NLEV) = rinter(NLEV)+(rinter(NLEV)-rinter(NLEV-1))/2.293 rmil(nlaykim_tot) = rinter(nlaykim_tot)+(rinter(nlaykim_tot)-rinter(nlaykim_tot-1))/2. 314 294 315 295 !----------------------------------------------------------------------- … … 326 306 nb(l) = 1.e-4*press_c(l) / (kbol*temp_c(l)) 327 307 ENDDO 328 ! extension pour klev+1 a NLEVavec tcp.ver308 ! extension pour klev+1 a nlaykim_tot avec tcp.ver 329 309 ialt=1 330 do l=klev+1, NLEV310 do l=klev+1,nlaykim_tot 331 311 zalt=rmil(l)-rad/1000. 332 312 do i=ialt,130 … … 371 351 endif 372 352 373 do l=1, NLEV353 do l=1,nlaykim_tot 374 354 375 355 ! INTERPOL EN ALT POUR k (krpd tous les deux km) … … 377 357 factalt = (rmil(l)-rad/1000.)/2.-(ialt-1) 378 358 379 do i=1, ND+1359 do i=1,nd_kim+1 380 360 krpddecm1 = krpd(declinint ,i,ialt ,klat(j)) * (1-factalt) & 381 361 + krpd(declinint ,i,ialt+1,klat(j)) * factalt … … 385 365 + krpd(declinint+2,i,ialt+1,klat(j)) * factalt 386 366 387 ! ND+1 correspond a la dissociation de N2 par les GCR367 ! nd_kim+1 correspond a la dissociation de N2 par les GCR 388 368 if ( factdec.lt.0. ) then 389 369 krate(l,i) = krpddecm1 * abs(factdec) & … … 403 383 ! ------------ 404 384 405 do ic=1, NC385 do ic=1,nkim 406 386 do l=1,klev 407 387 cqy(l,ic) = qy_c(j,l,ic) … … 410 390 enddo 411 391 412 ! lecture du fichier compo_klat(j) (01 à 49) pour klev+1 a NLEV392 ! lecture du fichier compo_klat(j) (01 à 49) pour klev+1 a nlaykim_tot 413 393 414 394 WRITE(str2,'(i2.2)') klat(j) … … 423 403 ! on lit la colonne t-1 au lieu de la colonne t 424 404 ! (cas d une bande de latitude partagee par 2 procs) 425 do ic=1, NC405 do ic=1,nkim 426 406 read(11,'(A10)') name 427 407 if (name.ne.nomqy_c(ic)) then … … 431 411 endif 432 412 if (ficdec.eq.curdec) then 433 do l=klev+1, NLEV413 do l=klev+1,nlaykim_tot 434 414 read(11,*) ficalt,cqy(l,ic),newq 435 415 enddo 436 416 else 437 do l=klev+1, NLEV417 do l=klev+1,nlaykim_tot 438 418 read(11,*) ficalt,oldq,cqy(l,ic) 439 419 enddo … … 442 422 close(11) 443 423 else ! le fichier n'est pas la 444 do ic=1, NC445 do l=klev+1, NLEV424 do ic=1,nkim 425 do l=klev+1,nlaykim_tot 446 426 cqy(l,ic)=cqy(klev,ic) 447 427 enddo … … 466 446 ! --------------------- 467 447 468 do ic=1, NC448 do ic=1,nkim 469 449 do l=1,klev 470 450 dqyc(j,l,ic) = (cqy(l,ic) - cqy0(l,ic))/dtchim ! en /s … … 475 455 !----------------------------------------------------------------------- 476 456 ! 477 ! sauvegarde compo sur NLEV457 ! sauvegarde compo sur nlaykim_tot 478 458 ! ------------------------- 479 459 … … 483 463 ! premiere ligne=declin 484 464 write(11,'(E15.5)') declin_c 485 do ic=1, NC465 do ic=1,nkim 486 466 write(11,'(A10)') nomqy_c(ic) 487 do l=klev+1, NLEV467 do l=klev+1,nlaykim_tot 488 468 write(11,'(E15.5,1X,E15.5,1X,E15.5)') rmil(l)-rad/1000.,cqy0(l,ic),cqy(l,ic) 489 469 enddo -
trunk/LMDZ.TITAN/libf/phytitan/chem_settings.F90
r1895 r1903 83 83 ! ( H=1, H2=2 ..., C4N2=44) -> cf comchem_h 84 84 85 DO iq=2, 4485 DO iq=2,nkim 86 86 CALL get_field(trim(cnames(iq))//"_up",ykim_up(iq,:,:),found,indextime) 87 87 IF (.NOT.found) THEN -
trunk/LMDZ.TITAN/libf/phytitan/comchem_h.F90
r1899 r1903 21 21 IMPLICIT NONE 22 22 23 !! Hard-coded number of chemical species for Titan chemistry 24 INTEGER, PARAMETER :: nkim = 44 25 23 26 !! Hard-coded chemical species for Titan chemistry 24 CHARACTER(len=10), DIMENSION( 44), PARAMETER :: cnames = &27 CHARACTER(len=10), DIMENSION(nkim), PARAMETER :: cnames = & 25 28 (/"H ", "H2 ", "CH ", "CH2s ", "CH2 ", "CH3 ", & 26 29 "CH4 ", "C2 ", "C2H ", "C2H2 ", "C2H3 ", "C2H4 ", & … … 31 34 "H2CN ", "CHCN ", "CH2CN ", "CH3CN ", "C3N ", "HC3N ", & 32 35 "NCCN ", "C4N2 "/) 36 !! Hard-coded chemical species for Titan chemistry + "HV" specie for the photochem module. 37 CHARACTER(len=10), DIMENSION(nkim+1), PARAMETER :: nomqy_c = & 38 (/"H ", "H2 ", "CH ", "CH2s ", "CH2 ", "CH3 ", & 39 "CH4 ", "C2 ", "C2H ", "C2H2 ", "C2H3 ", "C2H4 ", & 40 "C2H5 ", "C2H6 ", "C3H3 ", "C3H5 ", "C3H6 ", "C3H7 ", & 41 "C4H ", "C4H3 ", "C4H4 ", "C4H2s ", "CH2CCH2 ", "CH3CCH ", & 42 "C3H8 ", "C4H2 ", "C4H6 ", "C4H10 ", "AC6H6 ", "C3H2 ", & 43 "C4H5 ", "AC6H5 ", "N2 ", "N4S ", "CN ", "HCN ", & 44 "H2CN ", "CHCN ", "CH2CN ", "CH3CN ", "C3N ", "HC3N ", & 45 "NCCN ", "C4N2 ", "HV "/) 33 46 !! Hard-coded chemical species molar mass (g.mol-1), shares the same indexing than cnames. 34 REAL, DIMENSION( 44), PARAMETER :: cmmol = (/ &47 REAL, DIMENSION(nkim), PARAMETER :: cmmol = (/ & 35 48 1.01 , 2.0158, 13.02, 14.03, 14.03, 15.03, 16.04 , 24.02, 25.03, 26.04 , 27.05 , & 36 49 28.05 , 29.06 , 30.07, 39.06, 41.07, 42.08, 43.09 , 49.05, 51.07, 52.08 , 50.06 , & … … 38 51 14.01 , 26.02 , 27.04, 28.05, 39.05, 40.04, 41.05 , 50.04, 51.05, 52.04 , 76.1 /) 39 52 40 ! !!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!53 ! !!!!!!!!!!!!!!!!!!!! 41 54 ! Upper chemistry 42 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 55 ! !!!!!!!!!!!!!!!!!!!! 56 57 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 58 ! These parameters as well as nkim above, MUST match titan.h in chimtitan 59 INTEGER, PARAMETER :: nd_kim = 54 ! Number of photodissociations 60 INTEGER, PARAMETER :: nr_kim = 377 ! Number of reactions in chemistry scheme 61 INTEGER, PARAMETER :: nlrt_kim = 650 ! For the UV rad. transf., 650 levels of 2 km 62 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 43 63 44 64 INTEGER, SAVE :: nlaykim_up ! Number of upper atm. layers for chemistry from GCM top to 4.5E-5 Pa (1300km) … … 71 91 IF (.NOT.allocated(preskim)) ALLOCATE(preskim(nlaykim_up)) 72 92 IF (.NOT.allocated(zlay_kim)) ALLOCATE(zlay_kim(ngrid,nlaykim_tot)) 73 IF (.NOT.allocated(ykim_up)) ALLOCATE(ykim_up( 44,ngrid,nlaykim_up))93 IF (.NOT.allocated(ykim_up)) ALLOCATE(ykim_up(nkim,ngrid,nlaykim_up)) 74 94 75 95 END SUBROUTINE ini_comchem_h -
trunk/LMDZ.TITAN/libf/phytitan/inicondens.F90
r1672 r1903 1 SUBROUTINE inicondens( ny,press,temp,nomy,yc)1 SUBROUTINE inicondens(press,temp,yc) 2 2 3 3 !================================================================================== 4 4 ! Purpose 5 5 ! ------- 6 ! Initialisation des profils de saturation des traceurs 6 ! Initialisation des profils de saturation des traceurs chimiques 7 7 ! 8 8 ! Authors … … 17 17 ! ------------- 18 18 19 use comchem_h, only: nkim, cnames 19 20 use dimphy 20 21 use mod_grid_phy_lmdz, only: nbp_lev … … 23 24 ! Arguments : 24 25 ! ----------- 25 INTEGER, INTENT(IN) :: ny 26 CHARACTER*10,INTENT(IN) :: nomy(ny+1) 27 REAL, INTENT(IN) :: press(nbp_lev),temp(nbp_lev) ! pressure in mbar ! 28 REAL, INTENT(OUT) :: yc(nbp_lev,ny) 26 REAL, INTENT(IN) :: press(nbp_lev),temp(nbp_lev) ! Pressure (mbar) 27 REAL, INTENT(OUT) :: yc(nbp_lev,nkim) ! Saturation profiles (mol/mol) 29 28 30 29 ! Local variables : … … 33 32 REAL :: sy,x 34 33 35 do ic=1,n y36 print*, 'traceur CH(', ic, ')=', nomy(ic),'------------'34 do ic=1,nkim 35 print*, 'traceur CH(', ic, ')=', trim(cnames(ic)),'------------' 37 36 do l=1,nbp_lev 38 37 … … 40 39 yc(l,ic)=1. 41 40 42 if( nomy(ic).eq."CH4") then41 if(trim(cnames(ic)).eq."CH4") then 43 42 if (temp(l).lt.90.65) then 44 43 yc(l,ic)= 10.0**(4.42507e0 - ( ( ( 1165560.7e0 / TEMP(l) - & … … 54 53 endif 55 54 56 if( nomy(ic).eq."C2H2") then55 if(trim(cnames(ic)).eq."C2H2") then 57 56 yc(l,ic)= 10.0**(6.09748e0-1644.1e0/TEMP(l)+7.42346e0 & 58 57 * alog10(1.0e3/TEMP(l)) ) / PRESS(l)*1013.25e0/760.0 59 58 endif 60 59 61 if( nomy(ic).eq."C2H4") then60 if(trim(cnames(ic)).eq."C2H4") then 62 61 if (temp(l).lt.89.0) then 63 62 yc(l,ic)= 10.0**(1.5477e0 + (1.0e0/TEMP(l) - 0.011e0) & … … 76 75 endif 77 76 78 if( nomy(ic).eq."C2H6") then77 if(trim(cnames(ic)).eq."C2H6") then 79 78 if (temp(l).lt.90.) then 80 79 yc(l,ic)= 10.0**(10.01e0-1085.0e0/(TEMP(l)-0.561e0) ) & … … 86 85 endif 87 86 88 if(( nomy(ic).eq."CH3CCH").or.(nomy(ic).eq."CH2CCH2")) then87 if((trim(cnames(ic)).eq."CH3CCH").or.(trim(cnames(ic)).eq."CH2CCH2")) then 89 88 yc(l,ic)= 10.0**(2.8808e0 - 4.5e0*(249.9e0 - TEMP(l)) & 90 89 /(1.15e0*TEMP(l) - 37.485e0) ) / PRESS(l) * 1013.25e0 / 760.0e0 91 90 endif 92 91 93 if( nomy(ic).eq."C3H6") then92 if(trim(cnames(ic)).eq."C3H6") then 94 93 yc(l,ic)= 10.0**(7.4463e0 - 1028.5654e0/TEMP(l) ) / PRESS(l) * 1013.25e0 / 760.0e0 95 94 endif 96 95 97 if( nomy(ic).eq."C3H8") then96 if(trim(cnames(ic)).eq."C3H8") then 98 97 yc(l,ic)= 10.0**(7.217e0 - 994.30251e0/TEMP(l) ) / PRESS(l) * 1013.25e0 / 760.0e0 99 98 endif 100 99 101 if(( nomy(ic).eq."C4H2").or.(nomy(ic).eq."C4H2s")) then100 if((trim(cnames(ic)).eq."C4H2").or.(trim(cnames(ic)).eq."C4H2s")) then 102 101 yc(l,ic)= 10.0**(96.26781e0 - 4651.872e0/TEMP(l) - 31.68595e0 & 103 102 *alog10(TEMP(l)) ) / PRESS(l) * 1013.25e0 / 760.0e0 104 103 endif 105 104 106 if( nomy(ic).eq."C4H4") then105 if(trim(cnames(ic)).eq."C4H4") then 107 106 yc(l,ic)= 1.0e3 * exp(9.3898e0 - 2203.57/(TEMP(l)-43.15e0) ) / PRESS(l) 108 107 endif 109 108 110 if( nomy(ic).eq."C4H6") then109 if(trim(cnames(ic)).eq."C4H6") then 111 110 yc(l,ic)= 10.0**(2.8808e0 - 4.6e0*(262.3e0 - TEMP(l)) & 112 111 /(1.15e0*TEMP(l) - 39.345e0) ) / PRESS(l) * 1013.25e0 / 760.0e0 113 112 endif 114 113 115 if( nomy(ic).eq."C4H10") then114 if(trim(cnames(ic)).eq."C4H10") then 116 115 yc(l,ic)= 10.0**(8.446e0 - 1461.2e0/TEMP(l) ) / PRESS(l) * 1013.25e0 / 760.0e0 117 116 endif 118 117 119 if( nomy(ic).eq."C6H2") then118 if(trim(cnames(ic)).eq."C6H2") then 120 119 yc(l,ic)= 10.0**(4.666e0 - 4956e0/TEMP(l) + 25.845e0 * & 121 120 alog10(1.0e3/TEMP(l)) ) / PRESS(l) * 1013.25e0 / 760.0e0 122 121 endif 123 122 124 if( nomy(ic).eq."C8H2") then123 if(trim(cnames(ic)).eq."C8H2") then 125 124 yc(l,ic)= 10.0**(3.95e0 - 6613e0/TEMP(l) + 35.055e0 * & 126 125 alog10(1.0e3/TEMP(l)) ) / PRESS(l) * 1013.25e0 / 760.0e0 127 126 endif 128 127 129 if( nomy(ic).eq."AC6H6") then128 if(trim(cnames(ic)).eq."AC6H6") then 130 129 x = 1.0e0 - TEMP(l) / 562.2e0 131 130 yc(l,ic)= 48.9e3 * exp( ( 1.33213 * x**1.5 - 6.98273 * x & … … 133 132 endif 134 133 135 if( nomy(ic).eq."HCN") then134 if(trim(cnames(ic)).eq."HCN") then 136 135 yc(l,ic)= 10.0**(8.6165e0 - 1516.5e0/(TEMP(l) - 26.2e0) ) / PRESS(l) * 1013.25e0 / 760.0e0 137 136 endif 138 137 139 if( nomy(ic).eq."CH3CN") then138 if(trim(cnames(ic)).eq."CH3CN") then 140 139 yc(l,ic)= 10.0**(8.458e0 - 1911.7e0/TEMP(l) ) / PRESS(l) * 1013.25e0 / 760.0e0 141 140 endif 142 141 143 if( nomy(ic).eq."C2H3CN") then142 if(trim(cnames(ic)).eq."C2H3CN") then 144 143 yc(l,ic)= 10.0**(9.3051e0 - 2782.21/(TEMP(l) - 51.15e0) ) / PRESS(l) * 1013.25e0 / 760.0e0 145 144 endif 146 145 147 if( nomy(ic).eq."NCCN") then146 if(trim(cnames(ic)).eq."NCCN") then 148 147 yc(l,ic)= 10.0**(7.454e0 - 1832e0/TEMP(l) ) / PRESS(l) * 1013.25e0 / 760.0e0 149 148 endif 150 149 151 if( nomy(ic).eq."HC3N") then150 if(trim(cnames(ic)).eq."HC3N") then 152 151 yc(l,ic)= 10.0**(7.7446e0 - 1453.5609e0/TEMP(l) ) / PRESS(l) * 1013.25e0 / 760.0e0 153 152 endif 154 153 155 if( nomy(ic).eq."C4N2") then154 if(trim(cnames(ic)).eq."C4N2") then 156 155 yc(l,ic)= 10.0**(8.269e0 - 2155.0e0/TEMP(l) ) / PRESS(l) * 1013.25e0 / 760.0e0 157 156 endif -
trunk/LMDZ.TITAN/libf/phytitan/phyredem.F90
r1894 r1903 143 143 use iostart, only : open_restartphy, close_restartphy, & 144 144 put_var, put_field 145 use comchem_h, only: cnames, ykim_up145 use comchem_h, only: nkim, cnames, ykim_up 146 146 use tracer_h, only: noms 147 147 use callkeys_mod, only: callchim … … 196 196 ! Upper chemistry 197 197 if (callchim) then 198 do iq=1, 44198 do iq=1,nkim 199 199 call put_field(trim(cnames(iq))//"_up",trim(cnames(iq))//" in upper atmosphere",ykim_up(iq,:,:)) 200 200 enddo -
trunk/LMDZ.TITAN/libf/phytitan/physiq_mod.F90
r1902 r1903 19 19 use radcommon_h, only: sigma, glat, grav, BWNV 20 20 use surfdat_h, only: phisfi, zmea, zstd, zsig, zgam, zthe 21 use comchem_h, only: nkim 21 22 use comdiurn_h, only: coslat, sinlat, coslon, sinlon 22 23 use comsaison_h, only: mu0, fract, dist_star, declin, right_ascen … … 363 364 character(len=10) :: tmp2 364 365 365 ! Local variables for Titan chemistry and microphysics (JVO 2017) 366 ! ---------------------------------------------------------------------------- 367 368 character*10,dimension(:),allocatable,save :: nomqy 369 370 !$OMP THREADPRIVATE(nomqy) 371 366 ! Local variables for Titan chemistry and microphysics 367 ! ---------------------------------------------------- 368 372 369 real ctimestep ! Chemistry timestep (s) 373 370 374 real temp_eq(nlayer), press_eq(nlayer) ! Moyennes planétaires 375 376 real , allocatable, dimension(:,:,:),save :: ychim 377 378 ! 2D vmr tendencies ( chemistry and condensation ) for chem. tracers 379 real,dimension(:,:,:),allocatable,save :: dycchi ! Saved since chemistry is not called every step 380 real dyccond(ngrid,nlayer,nq) 381 382 real,dimension(:,:),allocatable,save :: qysat 383 384 !$OMP THREADPRIVATE(ychim,dycchi,qysat) 385 386 real,dimension(:),allocatable,save :: tankCH4 ! Depth of surface methane tank 371 ! Chemical tracers in molar fraction 372 real, dimension(:,:,:), allocatable, save :: ychim ! (mol/mol) 373 !$OMP THREADPRIVATE(ychim) 374 375 ! Molar fraction tendencies ( chemistry and condensation ) for tracers (mol/mol/s) 376 real, dimension(ngrid,nlayer,nq) :: dyccond ! All tracers, we want to use indx on it. 377 real, dimension(:,:,:), allocatable, save :: dycchi ! Only for chem tracers. Saved since chemistry is not called every step. 378 !$OMP THREADPRIVATE(dycchi) 379 380 ! Saturation profiles 381 real, dimension(:,:), allocatable, save :: qysat ! (mol/mol) 382 !$OMP THREADPRIVATE(qysat) 383 real temp_eq(nlayer), press_eq(nlayer) ! Planetary averages for the init. of saturation profiles. 384 385 ! Surface methane tank 386 real,dimension(:),allocatable,save :: tankCH4 ! Depth of surface methane tank (m) 387 387 !$OMP THREADPRIVATE(tankCH4) 388 388 … … 429 429 430 430 ! Initialisation of nmicro as well as tracers names, indexes ... 431 if (ngrid.ne.1) then 432 call initracer2(nq,nametrac) ! Already done in rcm1d431 if (ngrid.ne.1) then ! Already done in rcm1d 432 call initracer2(nq,nametrac) 433 433 endif 434 434 … … 463 463 ALLOCATE(zdtlw(ngrid,nlayer)) 464 464 ALLOCATE(zdtsw(ngrid,nlayer)) 465 ALLOCATE(dycchi(ngrid,nlayer,nq-nmicro)) 466 ALLOCATE(qysat(nlayer,nq-nmicro)) 467 ALLOCATE(nomqy(nq-nmicro+1)) ! +1 because of hv 468 465 469 466 ! This is defined in comsaison_h 470 467 ALLOCATE(mu0(ngrid)) … … 506 503 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 507 504 508 if ( callchim .and. (nq.gt.nmicro) ) then 509 510 allocate(ychim(ngrid,nlayer,nq-nmicro)) 511 505 if ( callchim ) then 506 507 allocate(ychim(ngrid,nlayer,nkim)) 508 allocate(dycchi(ngrid,nlayer,nkim)) ! only for chemical tracers 509 allocate(qysat(nlayer,nkim)) 510 511 ! Chemistry timestep 512 512 ctimestep = ptimestep*REAL(ichim) 513 513 514 do iq=nmicro+1,nq 515 nomqy(iq-nmicro) = nametrac(iq) 516 enddo 517 518 nomqy(nq-nmicro+1) = "HV" 519 520 ! qysat is taken at the equator ( small variations of t,p) 514 ! qysat is taken at the equator ( small variations of t,p ) 521 515 temp_eq(:) = tmoy(:) 522 press_eq(:) = playmoy(:)/100. ! en mbar523 524 call inicondens( nq-nmicro,press_eq,temp_eq,nomqy,qysat)516 press_eq(:) = playmoy(:)/100. ! in mbar 517 518 call inicondens(press_eq,temp_eq,qysat) 525 519 526 520 zdqchi(:,:,:) = 0.0 … … 1084 1078 if (callchim) then 1085 1079 1086 if (nq.gt.nmicro) then 1087 do iq = nmicro+1,nq 1088 ychim(:,:,iq-nmicro) = pq(:,:,iq) * rat_mmol(iq) ! convert to molar fraction 1089 enddo 1090 endif 1080 do iq = 1,nkim 1081 ychim(:,:,iq) = pq(:,:,iq+nmicro) * rat_mmol(iq+nmicro) ! convert to molar fraction 1082 enddo 1091 1083 1092 1084 ! Condensation tendency after the transport 1093 do iq= nmicro+1,nq1085 do iq=1,nkim 1094 1086 do l=1,nlayer 1095 1087 do ig=1,ngrid 1096 if ( ychim(ig,l,iq -nmicro).gt.qysat(l,iq-nmicro) ) then1097 dyccond(ig,l,iq )= ( -ychim(ig,l,iq-nmicro)+qysat(l,iq-nmicro) ) / ptimestep1088 if ( ychim(ig,l,iq).gt.qysat(l,iq) ) then 1089 dyccond(ig,l,iq+nmicro)= ( -ychim(ig,l,iq)+qysat(l,iq) ) / ptimestep 1098 1090 endif 1099 1091 enddo … … 1108 1100 1109 1101 if (ngrid.eq.1) then ! We obviously don't have access to (and don't need) zonal means in 1D 1110 call calchim(ngrid, nq-nmicro,ychim,nomqy,declin,zls,ctimestep, &1111 pt,pplay,pplev,zzlay,zzlev,dycchi ,nlayer+70)1102 call calchim(ngrid,ychim,declin,zls,ctimestep, & 1103 pt,pplay,pplev,zzlay,zzlev,dycchi) 1112 1104 else 1113 call calchim(ngrid,nq-nmicro,ychim,nomqy,declin,zls,ctimestep, & 1114 ztfibar,zplaybar,zplevbar,zzlaybar,zzlevbar,dycchi,nlayer+70) 1115 ! JVO 2017 : NLEV = nlayer+70, en accord avec le C. Quid si nlay=/ 55 ? 1105 call calchim(ngrid,ychim,declin,zls,ctimestep, & 1106 ztfibar,zplaybar,zplevbar,zzlaybar,zzlevbar,dycchi) 1116 1107 endif 1117 1108 … … 1122 1113 ! ( GCM-friendly tracers and tendencies -> format for photochem and microphys ) 1123 1114 1124 if (nq.gt.nmicro) then 1125 ! We convert tendencies to mass mixing ratio 1126 do iq=nmicro+1,nq 1127 zdqchi(:,:,iq) = dycchi(:,:,iq-nmicro) / rat_mmol(iq) 1128 zdqcond(:,:,iq) = dyccond(:,:,iq) / rat_mmol(iq) 1129 enddo 1130 1131 pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + & 1132 zdqchi(1:ngrid,1:nlayer,1:nq) + zdqcond(1:ngrid,1:nlayer,1:nq) 1115 ! We convert tendencies to mass mixing ratio 1116 do iq=1,nkim 1117 zdqchi(:,:,iq+nmicro) = dycchi(:,:,iq) / rat_mmol(iq+nmicro) 1118 zdqcond(:,:,iq+nmicro) = dyccond(:,:,iq+nmicro) / rat_mmol(iq+nmicro) 1119 enddo 1120 1121 pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + & 1122 zdqchi(1:ngrid,1:nlayer,1:nq) + zdqcond(1:ngrid,1:nlayer,1:nq) 1133 1123 1134 endif1135 1124 1136 1125 endif ! end of 'callchim' -
trunk/LMDZ.TITAN/libf/phytitan/tracer_h.F90
r1894 r1903 68 68 USE callkeys_mod 69 69 USE comcstfi_mod, only: mugaz 70 USE comchem_h, only: cnames, cmmol70 USE comchem_h, only: nkim, cnames, cmmol 71 71 IMPLICIT NONE 72 72 … … 146 146 147 147 IF (callchim) THEN 148 IF (nchimi < SIZE(cnames)) THEN149 WRITE(*,*) "initracer2:error: Inconsistent number of chemical species given (", SIZE(cnames)," expected)"148 IF (nchimi .NE. nkim) THEN 149 WRITE(*,*) "initracer2:error: Inconsistent number of chemical species given (",nkim," expected)" 150 150 CALL abort_gcm("initracer2", "inconsistent number of tracers", 42) 151 151 ENDIF 152 152 IF (.NOT.ALLOCATED(chimi_indx)) ALLOCATE(chimi_indx(nchimi)) 153 153 n = 0 ! counter on chimi_indx 154 DO j=1, SIZE(cnames)154 DO j=1,nkim 155 155 found = .false. 156 156 DO i=1,nq … … 168 168 ENDIF 169 169 ENDDO 170 IF (n < SIZE(cnames)) THEN171 WRITE(*,*) "initracer2:error: Inconsistent number of chemical species given (", SIZE(cnames)," expected)"170 IF (n .NE. nkim) THEN 171 WRITE(*,*) "initracer2:error: Inconsistent number of chemical species given (",nkim," expected)" 172 172 CALL abort_gcm("initracer2", "inconsistent number of tracers", 42) 173 173 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.