- Timestamp:
- Feb 27, 2024, 12:04:22 PM (9 months ago)
- Location:
- trunk
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.PLUTO.old/libf/phypluto/physiq.F
r3175 r3237 6 6 * pw, 7 7 * pdu,pdv,pdt,pdq,pdpsrf,tracerdyn) 8 8 9 9 use radinc_h, only : naerkind 10 use planet_h 10 use planet_h 11 11 USE ioipsl_getincom 12 12 use comgeomfi_h … … 42 42 ! - "startfi", "histfi" if it's time 43 43 ! - Saving statistics if "callstats = .true." 44 ! - Output any needed variables in "diagfi" 44 ! - Output any needed variables in "diagfi" 45 45 ! 10. Diagnostics: mass conservation of tracers, radiative energy balance etc. 46 46 ! … … 68 68 ! pt(ngrid,nlayer) Temperature (K) 69 69 ! pq(ngrid,nlayer,nq) Advected fields 70 ! pudyn(ngrid,nlayer) \ 70 ! pudyn(ngrid,nlayer) \ 71 71 ! pvdyn(ngrid,nlayer) \ Dynamical temporal derivative for the 72 72 ! ptdyn(ngrid,nlayer) / corresponding variables … … 88 88 ! Frederic Hourdin 15/10/93 89 89 ! Francois Forget 1994 90 ! Christophe Hourdin 02/1997 90 ! Christophe Hourdin 02/1997 91 91 ! Subroutine completly rewritten by F.Forget (01/2000) 92 92 ! Water ice clouds: Franck Montmessin (update 06/2003) 93 93 ! Radiatively active tracers: J.-B. Madeleine (10/2008-06/2009) 94 94 ! New correlated-k radiative scheme: R. Wordsworth (2009) 95 ! Many specifically Martian subroutines removed: R. Wordsworth (2009) 96 ! Pluto version improved :T. Bertrand (2015,2020) 95 ! Many specifically Martian subroutines removed: R. Wordsworth (2009) 96 ! Pluto version improved :T. Bertrand (2015,2020) 97 97 !================================================================== 98 98 … … 126 126 LOGICAL firstcall,lastcall 127 127 REAL pday 128 REAL ptime 128 REAL ptime 129 129 logical tracerdyn 130 130 … … 139 139 c Local saved variables: 140 140 c ---------------------- 141 INTEGER day_ini ! Initial date of the run (sol since Ls=0) 141 INTEGER day_ini ! Initial date of the run (sol since Ls=0) 142 142 INTEGER icount ! counter of calls to physiq during the run. 143 143 REAL tsurf(ngridmx) ! Surface temperature (K) 144 144 REAL tsoil(ngridmx,nsoilmx) ! sub-surface temperatures (K) 145 REAL,SAVE :: tidat(ngridmx,nsoilmx) ! thermal inertia soil 145 REAL,SAVE :: tidat(ngridmx,nsoilmx) ! thermal inertia soil 146 146 REAL tidat_out(ngridmx,nlayermx) ! thermal inertia soil but output on vertical grid 147 147 REAL tsub(ngridmx) ! temperature of the deepest layer … … 156 156 REAL,SAVE :: fluxgrd(ngridmx) ! surface conduction flux (W.m-2) 157 157 REAL,SAVE :: qsurf(ngridmx,nqmx) ! tracer on surface (e.g. kg.m-2) 158 REAL q2(ngridmx,nlayermx+1) ! Turbulent Kinetic Energy 159 REAL qsurf1(ngridmx,nqmx) ! saving qsurf to calculate flux over long timescales kg.m-2 158 REAL q2(ngridmx,nlayermx+1) ! Turbulent Kinetic Energy 159 REAL qsurf1(ngridmx,nqmx) ! saving qsurf to calculate flux over long timescales kg.m-2 160 160 REAL flusurf(ngridmx,nqmx) ! flux cond/sub kg.m-2.s-1 161 161 REAL,SAVE :: flusurfold(ngridmx,nqmx) ! old flux cond/sub kg.m-2.s-1 … … 165 165 REAL globavenewice(nqmx) ! globalaverage 2D ice 166 166 167 REAL,SAVE :: ptime0 ! store the first time 167 REAL,SAVE :: ptime0 ! store the first time 168 168 169 169 REAL dstep … … 175 175 176 176 177 REAL stephan 177 REAL stephan 178 178 DATA stephan/5.67e-08/ ! Stephan Boltzman constant 179 179 SAVE stephan … … 182 182 SAVE acond,bcond 183 183 REAL tcond1p4Pa 184 DATA tcond1p4Pa/38/ 184 DATA tcond1p4Pa/38/ 185 185 186 186 c Local variables : … … 191 191 REAL qsurfpal(ngridmx,nqmx) ! qsurf after a paleoclimate step : for physdem1 and restartfi 192 192 REAL phisfipal(ngridmx) ! geopotential after a paleoclimate step : for physdem1 and restartfi 193 REAL oblipal ! change of obliquity 194 REAL peri_daypal ! new periday 195 REAL eccpal ! change of eccentricity 196 REAL tpalnew ! change of time 193 REAL oblipal ! change of obliquity 194 REAL peri_daypal ! new periday 195 REAL eccpal ! change of eccentricity 196 REAL tpalnew ! change of time 197 197 REAL adjustnew ! change in N2 ice albedo 198 198 REAL pdaypal ! new pday = day_ini + step 199 199 REAL zdt_tot ! time range corresponding to the flux of qsurfyear 200 REAL massacc(nqmx) ! accumulated mass 201 REAL masslost(nqmx) ! accumulated mass 202 203 ! aerosol (ice or haze) extinction optical depth at reference wavelength 200 REAL massacc(nqmx) ! accumulated mass 201 REAL masslost(nqmx) ! accumulated mass 202 203 ! aerosol (ice or haze) extinction optical depth at reference wavelength 204 204 ! for the "naerkind" optically active aerosols: 205 REAL aerosol(ngridmx,nlayermx,naerkind) 206 207 CHARACTER*80 fichier 205 REAL aerosol(ngridmx,nlayermx,naerkind) 206 207 CHARACTER*80 fichier 208 208 INTEGER l,ig,ierr,igout,iq,i, tapphys 209 209 INTEGER lecttsoil ! lecture of tsoil from proftsoil … … 218 218 real,save :: fluxtop_dn(ngridmx) 219 219 real fluxabs_sw(ngridmx) ! absorbed shortwave radiation 220 real fluxdyn(ngridmx) ! horizontal heat transport by dynamics 220 real fluxdyn(ngridmx) ! horizontal heat transport by dynamics 221 221 222 222 REAL zls ! solar longitude (rad) 223 REAL zfluxuv ! Lyman alpha flux at 1AU 223 REAL zfluxuv ! Lyman alpha flux at 1AU 224 224 ! ph/cm2/s 225 225 REAL zday ! date (time since Ls=0, in martian days) 226 REAL saveday ! saved date 227 SAVE saveday 226 REAL saveday ! saved date 227 SAVE saveday 228 228 REAL savedeclin ! saved declin 229 229 SAVE savedeclin 230 !REAL adjust ! adjustment for surface albedo 230 !REAL adjust ! adjustment for surface albedo 231 231 REAL zzlay(ngridmx,nlayermx) ! altitude at the middle of the layers 232 232 REAL zzlev(ngridmx,nlayermx+1) ! altitude at layer boundaries … … 275 275 REAL zdqscofast(ngridmx) ! used only for fast model nogcm 276 276 REAL zdqcofast(ngridmx) ! used only for fast model nogcm 277 REAL zdqflow(ngridmx,nqmx) 277 REAL zdqflow(ngridmx,nqmx) 278 278 279 279 REAL zdteuv(ngridmx,nlayermx) ! (K/s) … … 283 283 real zdqmoldiff(ngridmx,nlayermx,nqmx) 284 284 285 ! Haze relatated tendancies 286 REAL zdqhaze(ngridmx,nlayermx,nqmx) 287 REAL zdqprodhaze(ngridmx,nqmx) 288 REAL zdqsprodhaze(ngridmx) 289 REAL zdqhaze_col(ngridmx) 285 ! Haze relatated tendancies 286 REAL zdqhaze(ngridmx,nlayermx,nqmx) 287 REAL zdqprodhaze(ngridmx,nqmx) 288 REAL zdqsprodhaze(ngridmx) 289 REAL zdqhaze_col(ngridmx) 290 290 REAL zdqphot_prec(ngrid,nlayer) 291 291 REAL zdqphot_ch4(ngrid,nlayer) 292 292 REAL zdqconv_prec(ngrid,nlayer) 293 REAL zdq_source(ngridmx,nlayermx,nqmx) 294 ! Fast Haze relatated tendancies 295 REAL fluxbot(ngridmx) 296 REAL gradflux(ngridmx) 293 REAL zdq_source(ngridmx,nlayermx,nqmx) 294 ! Fast Haze relatated tendancies 295 REAL fluxbot(ngridmx) 296 REAL gradflux(ngridmx) 297 297 REAL fluxlym_sol_bot(ngridmx) ! Solar flux Lyman alpha ph.m-2.s-1 reaching the surface 298 298 REAL fluxlym_ipm_bot(ngridmx) ! IPM (Interplanetary) flux Lyman alpha ph.m-2.s-1 reaching the surface 299 299 REAL flym_sol(ngridmx) ! Incident Solar flux Lyman alpha ph.m-2.s-1 300 REAL flym_ipm(ngridmx) ! Incident IPM (Interplanetary) flux Lyman alpha ph.m-2.s-1 300 REAL flym_ipm(ngridmx) ! Incident IPM (Interplanetary) flux Lyman alpha ph.m-2.s-1 301 301 302 302 real nconsMAX … … 336 336 real zdtdif(ngridmx,nlayermx), zdtadj(ngridmx,nlayermx) 337 337 real zdtdyn(ngridmx,nlayermx),ztprevious(ngridmx,nlayermx) 338 save ztprevious 338 save ztprevious 339 339 real qtot1,qtot2 ! total aerosol mass 340 340 integer igmin, lmin … … 351 351 352 352 real qcol(ngridmx,nqmx) 353 ! Pluto adding variables 353 ! Pluto adding variables 354 354 real vmr_ch4(ngridmx) ! vmr ch4 355 355 real vmr_co(ngridmx) ! vmr co … … 434 434 ptime0=ptime 435 435 write (*,*) 'In physiq ptime0 =', ptime 436 436 437 437 c Initialize albedo and orbital calculation 438 438 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ … … 451 451 phisfinew(ig)=phisfi(ig)-qsurf(ig,1)*g/1000. ! topo of bedrock below the ice 452 452 ENDDO 453 endif 453 endif 454 454 455 455 if (conservn2) then … … 457 457 call testconservmass(ngrid,nlayer,pplev(:,1),qsurf(:,1)) 458 458 endif 459 460 c initialize soil 459 460 c initialize soil 461 461 c ~~~~~~~~~~~~~~~ 462 462 IF (callsoil) THEN … … 499 499 500 500 if (conservn2) then 501 write(*,*) 'conservn2 iniloop' 501 write(*,*) 'conservn2 iniloop' 502 502 call testconservmass(ngrid,nlayer,pplev(:,1),qsurf(:,1)) 503 endif 504 505 igout=ngrid/2+1 503 endif 504 505 igout=ngrid/2+1 506 506 507 507 zday=pday+ptime ! compute time, in sols (and fraction thereof) … … 543 543 c Compute potential temperature zh 544 544 DO l=1,nlayer 545 DO ig=1,ngrid 545 DO ig=1,ngrid 546 546 zpopsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**rcp 547 547 zh(ig,l)=pt(ig,l)/zpopsk(ig,l) … … 555 555 c ajout de la conduction depuis la thermosphere 556 556 IF (callconduct) THEN 557 557 558 558 call conduction (ngrid,nlayer,ptimestep, 559 559 $ pplay,pt,zzlay,zzlev,zdtconduc,tsurf) … … 582 582 ENDDO 583 583 ENDDO 584 ENDIF 584 ENDIF 585 585 586 586 IF (callmoldiff) THEN … … 601 601 write(*,*) 'conservn2 thermo' 602 602 call testconservmass(ngrid,nlayer,pplev(:,1),qsurf(:,1)) 603 endif 603 endif 604 604 605 605 c----------------------------------------------------------------------- 606 606 c 2. Compute radiative tendencies : 607 607 c--------- -------------------------------------------------------------- 608 c Saving qsurf to compute paleo flux condensation/sublimation 608 c Saving qsurf to compute paleo flux condensation/sublimation 609 609 DO iq=1, nq 610 610 DO ig=1,ngrid … … 614 614 qsurf1(ig,iq)=qsurf(ig,iq) 615 615 ENDDO 616 ENDDO 616 ENDDO 617 617 618 618 IF (callrad) THEN … … 634 634 CALL solang(ngrid,sinlon,coslon,sinlat,coslat, 635 635 s ztim1,ztim2,ztim3,mu0,fract) 636 636 637 637 ELSE 638 638 CALL mucorr(ngrid,declin,lati,mu0,fract,10000.,rad) … … 643 643 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 644 644 if (ngrid.ne.1) then 645 645 646 646 !! Specific to change albedo of N2 so that Psurf 647 647 !! converges toward 1.4 Pa in "1989" seasons for Triton 648 648 !! converges toward 1.1 Pa in "2015" seasons for Pluto 649 if (convergeps) then 650 if (triton) then 649 if (convergeps) then 650 if (triton) then 651 651 ! 1989 declination 652 652 if (declin*180./pi.gt.-46..and.declin*180./pi.lt.-45. … … 656 656 if (globave.gt.1.5) then 657 657 adjust=adjust+0.005 658 else if (globave.lt.1.3) then 658 else if (globave.lt.1.3) then 659 659 adjust=adjust-0.005 660 660 endif … … 665 665 savedeclin=declin 666 666 else 667 ! Pluto : 2015 declination current epoch 667 ! Pluto : 2015 declination current epoch 668 668 if (declin*180./pi.gt.50.and.declin*180./pi.lt.51. 669 669 & .and.zday.gt.saveday+10000. … … 672 672 if (globave.gt.1.2) then 673 673 adjust=adjust+0.005 674 else if (globave.lt.1.) then 674 else if (globave.lt.1.) then 675 675 adjust=adjust-0.005 676 676 endif … … 698 698 c Fixed zenith angle in 1D 699 699 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 700 if(ngrid.eq.1.and.globmean1d) then 700 if(ngrid.eq.1.and.globmean1d) then 701 701 !global mean 1D radiative equiilium 702 702 ig=1 … … 719 719 & fluxtop_sw,fluxtop_dn,reffrad,tau_col,ptime,pday, 720 720 & firstcall,lastcall,zzlay) 721 721 722 722 c Radiative flux from the sky absorbed by the surface (W.m-2) 723 723 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ … … 734 734 ENDDO 735 735 ENDDO 736 736 737 737 else ! corrk = F 738 738 … … 754 754 755 755 ENDIF ! of if(mod(icount-1,iradia).eq.0) ie radiative timestep 756 756 757 757 ! Transformation of the radiative tendencies: 758 758 ! ------------------------------------------- … … 779 779 write(*,*) 'conservn2 radiat' 780 780 call testconservmass(ngrid,nlayer,pplev(:,1),qsurf(:,1)) 781 endif 781 endif 782 782 783 783 !----------------------------------------------------------------------- … … 807 807 & zdudif,zdvdif,zdhdif,zdtsdif,q2, 808 808 & zdqdif,zdqsdif,qsat_ch4,qsat_ch4_l1) !,zq1temp_ch4,qsat_ch4) 809 809 810 810 DO l=1,nlayer 811 811 DO ig=1,ngrid … … 825 825 acond=r/lw_n2 826 826 827 if (tracer) then 827 if (tracer) then 828 828 DO iq=1, nq 829 829 DO l=1,nlayer … … 856 856 !------------------------------------------------------------------ 857 857 858 ELSE ! case with calldifv=F 858 ELSE ! case with calldifv=F 859 859 ztim1=4.*stephan*ptimestep 860 860 DO ig=1,ngrid … … 870 870 871 871 c ------------------------------------------------------------------ 872 c Methane surface sublimation and condensation in fast model (nogcm) 872 c Methane surface sublimation and condensation in fast model (nogcm) 873 873 c ------------------------------------------------------------------ 874 874 if ((methane).and.(fast).and.condmetsurf) THEN … … 876 876 call ch4surf(ngrid,nlayer,nq,ptimestep, 877 877 & tsurf,zdtsurf,pplev,pdpsrf,pq,pdq,qsurf,dqsurf, 878 & zdqch4fast,zdqsch4fast) 878 & zdqch4fast,zdqsch4fast) 879 879 880 880 DO ig=1,ngrid 881 dqsurf(ig,igcm_ch4_ice)= dqsurf(ig,igcm_ch4_ice) + 881 dqsurf(ig,igcm_ch4_ice)= dqsurf(ig,igcm_ch4_ice) + 882 882 & zdqsch4fast(ig) 883 pdq(ig,1,igcm_ch4_gas)= pdq(ig,1,igcm_ch4_gas) + 883 pdq(ig,1,igcm_ch4_gas)= pdq(ig,1,igcm_ch4_gas) + 884 884 & zdqch4fast(ig) 885 885 zdtsurf(ig)=zdtsurf(ig)+lw_ch4*zdqsch4fast(ig)/capcal(ig) … … 887 887 end if 888 888 c ------------------------------------------------------------------ 889 c CO surface sublimation and condensation in fast model (nogcm) 889 c CO surface sublimation and condensation in fast model (nogcm) 890 890 c ------------------------------------------------------------------ 891 891 if ((carbox).and.(fast).and.condcosurf) THEN … … 893 893 call cosurf(ngrid,nlayer,nq,ptimestep, 894 894 & tsurf,pplev,pdpsrf,pq,pdq,qsurf,dqsurf, 895 & zdqcofast,zdqscofast) 895 & zdqcofast,zdqscofast) 896 896 897 897 DO ig=1,ngrid 898 dqsurf(ig,igcm_co_ice)= dqsurf(ig,igcm_co_ice) + 898 dqsurf(ig,igcm_co_ice)= dqsurf(ig,igcm_co_ice) + 899 899 & zdqscofast(ig) 900 pdq(ig,1,igcm_co_gas)= pdq(ig,1,igcm_co_gas) + 900 pdq(ig,1,igcm_co_gas)= pdq(ig,1,igcm_co_gas) + 901 901 & zdqcofast(ig) 902 902 zdtsurf(ig)=zdtsurf(ig)+lw_co*zdqscofast(ig)/capcal(ig) … … 905 905 906 906 ENDIF ! of IF (calldifv) 907 907 908 908 if (conservn2) then 909 909 write(*,*) 'conservn2 diff' 910 910 call testconservmass(ngrid,nlayer,pplev(:,1),qsurf(:,1)+ 911 911 & dqsurf(:,1)*ptimestep) 912 endif 912 endif 913 913 914 914 !------------------------------------------------------------------ … … 952 952 ENDDO 953 953 954 if(tracer) then 954 if(tracer) then 955 955 DO iq=1, nq 956 956 DO l=1,nlayer 957 957 DO ig=1,ngrid 958 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqadj(ig,l,iq) 958 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqadj(ig,l,iq) 959 959 ENDDO 960 960 ENDDO … … 992 992 c & pdpsrf,ptimestep) 993 993 994 if (tracer) then 994 if (tracer) then 995 995 zdqc(:,:,:)=0. 996 996 zdqsc(:,:)=0. 997 997 call condens_n2(ngrid,nlayer,nq,ptimestep, 998 998 & capcal,pplay,pplev,tsurf,pt, 999 & pphi,pdt,pdu,pdv,zdtsurf,pu,pv,pq,pdq, 999 & pphi,pdt,pdu,pdv,zdtsurf,pu,pv,pq,pdq, 1000 1000 & qsurf(1,igcm_n2),albedo,emis, 1001 1001 & zdtc,zdtsurfc,pdpsrf,zduc,zdvc, … … 1036 1036 dqsurf(ig,igcm_n2)= dqsurf(ig,igcm_n2) + zdqsc(ig,igcm_n2) 1037 1037 ENDDO 1038 1038 1039 1039 ENDIF ! of IF (N2cond) 1040 1040 … … 1043 1043 call testconservmass(ngrid,nlayer,pplev(:,1)+ 1044 1044 & pdpsrf(:)*ptimestep,qsurf(:,1)+dqsurf(:,1)*ptimestep) 1045 endif 1046 1045 endif 1046 1047 1047 !------------------------------------------------------------------ 1048 1048 ! test n2 conservation for one tendency / pplevis not updated here w pdpsrf … … 1067 1067 1068 1068 c----------------------------------------------------------------------- 1069 c 7. Specific parameterizations for tracers 1069 c 7. Specific parameterizations for tracers 1070 1070 c ----------------------------------------- 1071 1071 1072 if (tracer) then 1072 if (tracer) then 1073 1073 1074 1074 c 7a. Methane, CO, and ice 1075 1075 c --------------------------------------- 1076 c Methane ice condensation in the atmosphere 1076 c Methane ice condensation in the atmosphere 1077 1077 c ---------------------------------------- 1078 1078 zdqch4cloud(:,:,:)=0. … … 1156 1156 c endif ! carbox 1157 1157 !------------------------------------------------------------------ 1158 1159 c 7b. Haze particle production 1158 1159 c 7b. Haze particle production 1160 1160 c ------------------- 1161 1161 IF (haze) THEN 1162 1162 1163 1163 zdqphot_prec(:,:)=0. 1164 1164 zdqphot_ch4(:,:)=0. … … 1170 1170 & /ptimestep 1171 1171 else 1172 call hazecloud(ngrid,nlayer,nq,ptimestep, 1172 call hazecloud(ngrid,nlayer,nq,ptimestep, 1173 1173 & pplay,pplev,pq,pdq,dist_sol,mu0,zfluxuv,zdqhaze, 1174 1174 & zdqphot_prec,zdqphot_ch4,zdqconv_prec,declin) … … 1206 1206 c ------------------- 1207 1207 1208 c ------------- 1208 c ------------- 1209 1209 c Sedimentation 1210 c ------------- 1211 IF (sedimentation) THEN 1210 c ------------- 1211 IF (sedimentation) THEN 1212 1212 call zerophys(ngrid*nlayer*nq, zdqsed) 1213 1213 call zerophys(ngrid*nq, zdqssed) … … 1217 1217 & pq, pdq, zdqsed, zdqssed,nq,pphi) 1218 1218 1219 DO iq=1, nq 1219 DO iq=1, nq 1220 1220 DO l=1,nlayer 1221 1221 DO ig=1,ngrid … … 1251 1251 ! call massn2(ngrid,nlayer,pplev,qsurf(:,1),dqsurf(:,igcm_n2), 1252 1252 ! & pdpsrf,ptimestep) 1253 1253 1254 1254 c --------------------------------- 1255 1255 c Updating tracer budget on surface (before spread of glacier) … … 1258 1258 DO ig=1,ngrid 1259 1259 qsurf(ig,iq)=qsurf(ig,iq)+ptimestep*dqsurf(ig,iq) 1260 ENDDO 1261 ENDDO 1262 1263 endif ! of if (tracer) 1260 ENDDO 1261 ENDDO 1262 1263 endif ! of if (tracer) 1264 1264 1265 1265 if (conservn2) then … … 1267 1267 call testconservmass(ngrid,nlayer,pplev(:,1)+ 1268 1268 & pdpsrf(:)*ptimestep,qsurf(:,1)) 1269 endif 1270 1271 DO ig=1,ngrid 1269 endif 1270 1271 DO ig=1,ngrid 1272 1272 flusurf(ig,igcm_n2)=(qsurf(ig,igcm_n2)- 1273 1273 & qsurf1(ig,igcm_n2))/ptimestep … … 1285 1285 ENDDO 1286 1286 1287 !! Special source of haze particle ! 1287 !! Special source of haze particle ! 1288 1288 ! todo: should be placed in haze and use tendency of n2 instead of flusurf 1289 1289 IF (source_haze) THEN 1290 call hazesource(ngrid,nlayer,nq,ptimestep, 1290 call hazesource(ngrid,nlayer,nq,ptimestep, 1291 1291 & pplev,flusurf,mu0,zdq_source) 1292 1293 DO iq=1, nq 1292 1293 DO iq=1, nq 1294 1294 DO l=1,nlayer 1295 1295 DO ig=1,ngrid … … 1313 1313 1314 1314 ENDDO 1315 1315 1316 1316 ! 9.1 Increment Surface temperature: 1317 1317 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1318 1318 DO ig=1,ngrid 1319 tsurf(ig)=tsurf(ig)+ptimestep*zdtsurf(ig) 1319 tsurf(ig)=tsurf(ig)+ptimestep*zdtsurf(ig) 1320 1320 ENDDO 1321 1321 1322 1322 ! Prevent surface (.e.g. non volatile ch4) to exceed max temperature 1323 1323 ! Lellouch et al., 2000,2011 … … 1343 1343 tidat_out(:,l)=tidat(:,l) 1344 1344 ENDDO 1345 1345 1346 1346 ! 9.3 multiply tendencies of cond/subli for paleo loop only in the 1347 1347 ! last Pluto year of the simulation … … 1368 1368 dstep=mod(zday-day_ini-ptime0,glastep)*daysec 1369 1369 else 1370 dstep=glastep*daysec 1370 dstep=glastep*daysec 1371 1371 endif 1372 1372 zdqflow(:,:)=qsurf(:,:) … … 1383 1383 call testconservmass(ngrid,nlayer,pplev(:,1)+ 1384 1384 & pdpsrf(:)*ptimestep,qsurf(:,1)) 1385 endif 1385 endif 1386 1386 1387 1387 endif … … 1397 1397 flux3 = 0 1398 1398 do ig=1,ngrid 1399 flux1 = flux1 + 1399 flux1 = flux1 + 1400 1400 & area(ig)*(fluxtop_dn(ig) - fluxtop_sw(ig)) 1401 flux2 = flux2 + area(ig)*fluxtop_lw(ig) 1402 flux3 = flux3 + area(ig)*fluxtop_dn(ig) 1401 flux2 = flux2 + area(ig)*fluxtop_lw(ig) 1402 flux3 = flux3 + area(ig)*fluxtop_dn(ig) 1403 1403 fluxabs_sw(ig)=fluxtop_dn(ig) - fluxtop_sw(ig) 1404 1404 … … 1406 1406 print*,'Incident solar flux, absorbed solar flux, OLR (W/m2)' 1407 1407 print*, flux3/totarea, ' ', flux1/totarea , 1408 & ' = ', flux2/totarea 1408 & ' = ', flux2/totarea 1409 1409 1410 1410 if(meanOLR)then … … 1421 1421 do ig=1,ngrid 1422 1422 ts1 = ts1 + area(ig)*tsurf(ig) 1423 ts2 = min(ts2,tsurf(ig)) 1424 ts3 = max(ts3,tsurf(ig)) 1423 ts2 = min(ts2,tsurf(ig)) 1424 ts3 = max(ts3,tsurf(ig)) 1425 1425 end do 1426 ! print*,'Mean Tsurf =',ts1/totarea , ' Min Tsurf=',ts2, 1426 ! print*,'Mean Tsurf =',ts1/totarea , ' Min Tsurf=',ts2, 1427 1427 ! & ' Max Tsurf =',ts3 1428 ! print*,'Max Tsurf=',ts3,'Min Tsurf=',ts2 1428 ! print*,'Max Tsurf=',ts3,'Min Tsurf=',ts2 1429 1429 1430 1430 ! ------------------------------- … … 1495 1495 1496 1496 ! pressure density 1497 IF (.not.fast) then ! 1497 IF (.not.fast) then ! 1498 1498 DO ig=1,ngrid 1499 1499 DO l=1,nlayer … … 1510 1510 ! --------------------------------------------------------- 1511 1511 call zerophys(ngrid*nq,qcol) 1512 if(tracer.and..not.fast)then 1512 if(tracer.and..not.fast)then 1513 1513 do iq=1,nq 1514 1514 DO ig=1,ngrid … … 1527 1527 & mmol(igcm_n2)/mmol(igcm_ch4_gas)*100. 1528 1528 ENDDO 1529 ELSE 1529 ELSE 1530 1530 DO ig=1,ngrid 1531 1531 ! compute vmr methane 1532 vmr_ch4(ig)=qcol(ig,igcm_ch4_gas)* 1532 vmr_ch4(ig)=qcol(ig,igcm_ch4_gas)* 1533 1533 & g/ps(ig)*mmol(igcm_n2)/mmol(igcm_ch4_gas)*100. 1534 ! compute density methane 1534 ! compute density methane 1535 1535 DO l=1,nlayer 1536 zrho_ch4(ig,l)=zq(ig,l,igcm_ch4_gas)*rho(ig,l) 1536 zrho_ch4(ig,l)=zq(ig,l,igcm_ch4_gas)*rho(ig,l) 1537 1537 ENDDO 1538 ENDDO 1538 ENDDO 1539 1539 ENDIF 1540 1540 endif … … 1546 1546 & mmol(igcm_n2)/mmol(igcm_co_gas)*100. 1547 1547 ENDDO 1548 ELSE 1548 ELSE 1549 1549 DO ig=1,ngrid 1550 1550 ! compute vmr CO 1551 vmr_co(ig)=qcol(ig,igcm_co_gas)* 1551 vmr_co(ig)=qcol(ig,igcm_co_gas)* 1552 1552 & g/ps(ig)*mmol(igcm_n2)/mmol(igcm_co_gas)*100. 1553 1553 ! compute density CO 1554 1554 DO l=1,nlayer 1555 zrho_co(ig,l)=zq(ig,l,igcm_co_gas)*rho(ig,l) 1555 zrho_co(ig,l)=zq(ig,l,igcm_co_gas)*rho(ig,l) 1556 1556 ENDDO 1557 ENDDO 1557 ENDDO 1558 1558 ENDIF 1559 1559 endif … … 1564 1564 DO ig=1,ngrid 1565 1565 DO l=1,nlayer 1566 zrho_haze(ig,l)=zq(ig,l,igcm_haze)*rho(ig,l) 1567 zdqrho_photprec(ig,l)=zdqphot_prec(ig,l)*rho(ig,l) 1566 zrho_haze(ig,l)=zq(ig,l,igcm_haze)*rho(ig,l) 1567 zdqrho_photprec(ig,l)=zdqphot_prec(ig,l)*rho(ig,l) 1568 1568 ENDDO 1569 ENDDO 1569 ENDDO 1570 1570 ENDIF 1571 1571 … … 1598 1598 CLOSE(13) 1599 1599 ENDIF 1600 1600 1601 1601 1602 1602 IF (ngrid.NE.1) THEN … … 1651 1651 ENDIF 1652 1652 ENDDO 1653 ENDDO 1653 ENDDO 1654 1654 ! Finally ensure conservation of qsurf 1655 1655 DO iq=1,nq … … 1721 1721 ! "stats") only possible in 3D runs ! 1722 1722 1723 1723 1724 1724 IF (callstats) THEN 1725 write (*,*) "stats have been turned off in the code. 1725 write (*,*) "stats have been turned off in the code. 1726 1726 & You can manage your own output in physiq.F " 1727 1727 stop … … 1755 1755 1756 1756 ! --------------------------------------------------------------------- 1757 ! 3D OUTPUTS 1757 ! 3D OUTPUTS 1758 1758 ! ---------------------------------------------------------------------- 1759 1759 ! output in netcdf file "DIAGFI", containing any variable for diagnostic 1760 1760 ! (output with period "ecritphy", set in "run.def") 1761 1761 ! ---------------------------------------------------------------------- 1762 1762 1763 1763 ! if(MOD(countG3D,saveG3D).eq.0)then 1764 1764 ! print*,'countG3D',countG3D … … 1786 1786 & albedo) 1787 1787 call WRITEDIAGFI(ngrid,"emissivite","emissivite","sans dim",2, 1788 & emis) 1788 & emis) 1789 1789 call WRITEDIAGFI(ngrid,"fluxtop_dn","fluxtop_dn","sans dim",2, 1790 & fluxtop_dn) 1790 & fluxtop_dn) 1791 1791 call WRITEDIAGFI(ngrid,"ISR","incoming stellar rad.","W m-2", 1792 1792 & 2,fluxtop_dn) … … 1876 1876 call WRITEDIAGFI(ngrid,"zdtdif","zdtdif","K",3,zdtdif) 1877 1877 call WRITEDIAGFI(ngrid,"zdtconduc","tendancy T conduc", 1878 & "K",3,zdtconduc) 1878 & "K",3,zdtconduc) 1879 1879 call WRITEDIAGFI(ngrid,"zdtdyn","Dyn. heating","T s-1",3,zdtdyn) 1880 1880 call WRITEDIAGFI(ngrid,"zdtrad","rad heating","T s-1",3,dtrad) … … 1925 1925 & trim(noms(iq))//'_col', 1926 1926 & 'kg m^-2',2,qcol(1,iq) ) 1927 1927 1928 1928 ! call WRITEDIAGFI(ngridmx,trim(noms(iq))//'_aero', 1929 1929 ! & trim(noms(iq))//'_aero', … … 1932 1932 1933 1933 enddo 1934 1934 1935 1935 call WRITEDIAGFI(ngridmx,'haze_reff', 1936 1936 & 'haze_reff', … … 2015 2015 2016 2016 if (haze) then 2017 2017 2018 2018 ! call WRITEDIAGFI(ngrid,"zrho_haze","zrho_haze","kg.m-3", 2019 2019 ! & 3,zrho_haze(:,:)) … … 2055 2055 2056 2056 ! ---------------------------------------------------------------------- 2057 ! 1D OUTPUTS 2057 ! 1D OUTPUTS 2058 2058 ! ---------------------------------------------------------------------- 2059 2059 ELSE ! if(ngrid.eq.1) 2060 2060 2061 2061 if(countG1D.eq.saveG1D)then 2062 2062 2063 2063 ! BASIC 1D ONLY 2064 2064 … … 2097 2097 call WRITEDIAGFI(ngrid,"tidat","tidat","SI",1,tidat_out(1,:)) 2098 2098 2099 ! OUTPUT OF TENDANCIES 2099 ! OUTPUT OF TENDANCIES 2100 2100 ! call WRITEDIAGFI(ngrid,"zdqcloud","ch4 cloud","T s-1", 2101 2101 ! & 3,zdqcloud(1,1,igcm_ch4_gas)) … … 2140 2140 ! 1D Haze 2141 2141 if (haze) then 2142 2142 2143 2143 ! call WRITEDIAGFI(ngrid,"zrho_haze","zrho_haze","kg.m-3", 2144 2144 ! & 1,zrho_haze(:,:)) … … 2173 2173 & "aerosol optical depth","[]",3,aerosol(1,1,1)) 2174 2174 endif 2175 2175 2176 2176 ! TRACERS 1D ONLY 2177 2177 if (tracer) then -
trunk/LMDZ.PLUTO.old/libf/phypluto/vdifc.F
r3175 r3237 67 67 68 68 c Traceurs : 69 integer nq 69 integer nq 70 70 REAL pqsurf(ngrid,nq) 71 real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq) 72 real pdqdif(ngrid,nlay,nq) 73 real pdqdifeddy(ngrid,nlay,nq) 71 real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq) 72 real pdqdif(ngrid,nlay,nq) 73 real pdqdifeddy(ngrid,nlay,nq) 74 74 real pdqsdif(ngrid,nq),pdqsdif1(ngrid,nq) 75 75 76 76 c local: 77 77 c ------ … … 106 106 107 107 c variable added for N2 condensation: 108 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 108 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 109 109 REAL hh , zhcond(ngridmx,nlayermx) 110 110 c REAL latcond,tcond1p4Pa … … 116 116 117 117 c Tracers : 118 c ~~~~~~~ 118 c ~~~~~~~ 119 119 INTEGER iq 120 120 REAL zq(ngridmx,nlayermx,nqmx) … … 206 206 c ----------------------------------- 207 207 208 if (condensn2) then 208 if (condensn2) then 209 209 DO ilev=1,nlay 210 210 DO ig=1,ngrid … … 216 216 DO ilev=1,nlay 217 217 DO ig=1,ngrid 218 zhcond(ig,ilev) = 0. 218 zhcond(ig,ilev) = 0. 219 219 END DO 220 220 END DO … … 259 259 !TB16: GCM wind for flat hemisphere 260 260 IF (phisfi(ig).eq.0.) zu2=max(2.,zu2) 261 261 262 262 zcdv(ig)=zcdv_true(ig)*sqrt(zu2) 263 263 zcdh(ig)=zcdh_true(ig)*sqrt(zu2) … … 265 265 266 266 c ** schema de diffusion turbulente dans la couche limite 267 c ---------------------------------------------------- 267 c ---------------------------------------------------- 268 268 269 269 CALL vdif_kc(ptimestep,g,pzlev,pzlay … … 322 322 c -------------------------------- 323 323 324 c ** l'equation est 324 c ** l'equation est 325 325 c u(t+1) = u(t) + dt * {(du/dt)phys}(t) + dt * {(du/dt)difv}(t+1) 326 326 c avec … … 330 330 c donc les entrees sont /zcdv/ pour la condition a la limite sol 331 331 c et /zkv/ = Ku 332 332 333 333 CALL multipl((nlay-1)*ngrid,zkv(1,2),zb0(1,2),zb(1,2)) 334 334 CALL multipl(ngrid,zcdv,zb0,zb) … … 363 363 c -------------------------------- 364 364 365 c ** l'equation est 365 c ** l'equation est 366 366 c v(t+1) = v(t) + dt * {(dv/dt)phys}(t) + dt * {(dv/dt)difv}(t+1) 367 367 c avec … … 402 402 c ------------------------ 403 403 404 c ** l'equation est 404 c ** l'equation est 405 405 c h(t+1) = h(t) + dt * {(dh/dt)phys}(t) + dt * {(dh/dt)difv}(t+1) 406 406 c avec … … 443 443 c a t + \delta t, 444 444 c c'est a dire le flux radiatif a {t + \delta t} 445 c + le flux turbulent a {t + \delta t} 445 c + le flux turbulent a {t + \delta t} 446 446 c qui s'ecrit K (T1-Tsurf) avec T1 = d1 Tsurf + c1 447 c (notation K dt = /cpp*b/) 447 c (notation K dt = /cpp*b/) 448 448 c + le flux dans le sol a t 449 449 c + l'evolution du flux dans le sol lorsque la temperature d'interface … … 467 467 c end if 468 468 ENDDO 469 470 c ** et a partir de la temperature au sol on remonte 469 470 c ** et a partir de la temperature au sol on remonte 471 471 c ----------------------------------------------- 472 472 … … 478 478 ENDDO 479 479 480 480 481 481 c----------------------------------------------------------------------- 482 482 c TRACERS … … 487 487 c Using the wind modified by friction for lifting and sublimation 488 488 c ---------------------------------------------------------------- 489 ! This is computed above 489 ! This is computed above 490 490 491 491 ! DO ig=1,ngrid … … 495 495 ! ENDDO 496 496 497 c Calcul flux vertical au bas de la premiere couche (cf dust on Mars) 497 c Calcul flux vertical au bas de la premiere couche (cf dust on Mars) 498 498 c ----------------------------------------------------------- 499 do ig=1,ngridmx 499 do ig=1,ngridmx 500 500 rho(ig) = zb0(ig,1) /ptimestep 501 501 ! zb(ig,1) = 0. … … 503 503 504 504 call zerophys(ngrid*nq,pdqsdif) 505 pdqdif(:,:,:)=0. 505 pdqdif(:,:,:)=0. 506 506 507 507 … … 519 519 ! ENDDO 520 520 521 c pdqdifeddy(:,:,:)=0. 521 c pdqdifeddy(:,:,:)=0. 522 522 cc injection a 50 km 523 523 c DO ig=1,ngrid … … 529 529 c ENDDO 530 530 531 c Inversion pour l'implicite sur q 531 c Inversion pour l'implicite sur q 532 532 c -------------------------------- 533 do iq=1,nq 534 CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2)) 533 do iq=1,nq 534 CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2)) 535 535 536 536 if ((methane).and.(iq.eq.igcm_ch4_gas)) then 537 c This line is required to account for turbulent transport 537 c This line is required to account for turbulent transport 538 538 c from surface (e.g. ice) to mid-layer of atmosphere: 539 539 CALL multipl(ngrid,zcdv,zb0,zb(1,1)) … … 548 548 zc(ig,nlay)=za(ig,nlay)*zq(ig,nlay,iq)*z1(ig) 549 549 zd(ig,nlay)=zb(ig,nlay)*z1(ig) 550 ENDDO 551 550 ENDDO 551 552 552 DO ilay=nlay-1,2,-1 553 553 DO ig=1,ngrid … … 559 559 ENDDO 560 560 ENDDO 561 561 562 562 ! special case for methane and CO ice tracer: do not include 563 563 ! ice tracer from surface (which is set when handling … … 587 587 ENDDO 588 588 endif ! of if (methane.and.(iq.eq.igcm_ch4_ice)) 589 589 590 590 c Calculation for turbulent exchange with the surface (for ice) 591 IF (methane.and.(iq.eq.igcm_ch4_gas)) then 591 IF (methane.and.(iq.eq.igcm_ch4_gas)) then 592 592 593 593 !! calcul de la valeur de q a la surface : … … 601 601 !! Prevent CH4 condensation at the surface 602 602 if (.not.condmetsurf) then 603 qsat_ch4=qsat_ch4*1.e6 603 qsat_ch4=qsat_ch4*1.e6 604 604 endif 605 605 … … 625 625 626 626 zq1temp_ch4(ig)=zc(ig,1) 627 endif 627 endif 628 628 629 629 zq(ig,1,igcm_ch4_gas)=zq1temp_ch4(ig) 630 630 631 c TB: MODIF speciale pour CH4 631 c TB: MODIF speciale pour CH4 632 632 pdtsrf(ig)=pdtsrf(ig)+ 633 633 & lw_ch4*pdqsdif(ig,igcm_ch4_ice)/pcapcal(ig) … … 644 644 !! Prevent CO condensation at the surface 645 645 if (.not.condcosurf) then 646 qsat_co=qsat_co*1.e6 646 qsat_co=qsat_co*1.e6 647 647 endif 648 648 … … 654 654 END DO 655 655 656 656 657 657 DO ig=1,ngrid 658 658 c ------------------------------------------------------------- 659 659 c TEMPORAIRE : pour initialiser CO si glacier N2 660 660 c meme si il n'y a pas de CO disponible 661 c if (pqsurf(ig,igcm_n2).le.10.) then 661 c if (pqsurf(ig,igcm_n2).le.10.) then 662 662 c ------------------------------------------------------------- 663 c 663 c 664 664 if ((-pdqsdif(ig,igcm_co_ice)*ptimestep) 665 665 & .gt.(pqsurf(ig,igcm_co_ice))) then … … 671 671 $ (-pdqsdif(ig,igcm_co_ice)) *ptimestep) *z1(ig) 672 672 zq1temp_co(ig)=zc(ig,1) 673 endif 674 c endif 673 endif 674 c endif 675 675 676 676 zq(ig,1,igcm_co_gas)=zq1temp_co(ig) … … 717 717 ENDDO 718 718 719 if (tracer) then 719 if (tracer) then 720 720 DO iq = 1, nq 721 721 DO ilev = 1, nlay … … 730 730 end if 731 731 732 c ** diagnostique final 732 c ** diagnostique final 733 733 c ------------------ 734 734 -
trunk/LMDZ.PLUTO/libf/phypluto/callkeys_mod.F90
r3195 r3237 37 37 logical,save :: sedimentation 38 38 logical,save :: generic_condensation 39 !$OMP THREADPRIVATE(varactive,varfixed,sedimentation,generic_condensation ,generic_rain)39 !$OMP THREADPRIVATE(varactive,varfixed,sedimentation,generic_condensation) 40 40 logical,save :: aeron2, aeroh2o, aeroh2so4, aeroback2lay 41 41 !$OMP THREADPRIVATE(aeron2, aeroh2o, aeroh2so4, aeroback2lay) … … 191 191 real,save :: rad_haze 192 192 !$OMP THREADPRIVATE(rad_haze) 193 logical,save :: UseVdifcPlutold 194 !$OMP THREADPRIVATE(UseVdifcPlutold) 193 195 194 196 logical,save :: global1d -
trunk/LMDZ.PLUTO/libf/phypluto/inifis_mod.F90
r3228 r3237 183 183 if (is_master) write(*,*) trim(rname)//": fast = ",fast 184 184 185 if (is_master) write(*,*) trim(rname)//"Run with Triton orbit ?" 186 triton=.false. ! default value 187 call getin_p("triton",triton) 188 if (is_master) write(*,*) trim(rname)//" triton = ",triton 189 convergeps=.false. ! default value 190 call getin_p("convergeps",convergeps) 191 if (is_master) write(*,*) trim(rname)//" convergeps = ",convergeps 192 193 if (is_master) write(*,*) trim(rname)//"KBO runs (eris, makemake) ?" 194 kbo=.false. ! default value 195 call getin_p("kbo",kbo) 196 if (is_master) write(*,*) trim(rname)//" kbo = ",kbo 197 198 if (is_master) write(*,*) trim(rname)//"Specific paleo run ?" 199 paleo=.false. ! default value 200 call getin_p("paleo",paleo) 201 if (is_master) write(*,*) trim(rname)//" paleo = ",paleo 202 203 if (is_master) write(*,*) trim(rname)//"paleoclimate step (Earth years) " 204 paleoyears=10000. ! default value 205 call getin_p("paleoyears",paleoyears) 206 if (is_master) write(*,*) trim(rname)//" paleoyears = ",paleoyears 207 185 208 if (is_master) write(*,*) trim(rname)//& 186 209 ": No seasonal cycle: initial day to lock the run during restart" … … 279 302 call getin_p("UseTurbDiff",UseTurbDiff) 280 303 if (is_master) write(*,*) trim(rname)//": UseTurbDiff = ",UseTurbDiff 304 305 if (is_master) write(*,*) trim(rname)//": use vdifc from old Pluto ?" 306 UseVdifcPlutold=.true. ! default value 307 call getin_p("UseVdifcPlutold",UseVdifcPlutold) 308 if (is_master) write(*,*) trim(rname)//": UseVdifcPlutold = ",UseVdifcPlutold 281 309 282 310 if (is_master) write(*,*) trim(rname)//": call convective adjustment ?" -
trunk/LMDZ.PLUTO/libf/phypluto/initracer.F90
r3195 r3237 421 421 lw_ch4=586700. 422 422 lw_n2=2.5e5 423 write(*,*) "lw_n2 = ", lw_n2 423 424 424 425 if (haze) then -
trunk/LMDZ.PLUTO/libf/phypluto/physiq_mod.F90
r3232 r3237 32 32 USE comgeomfi_h, only: totarea, totarea_planet 33 33 USE tracer_h, only: noms, mmol, radius, rho_q, qext, & 34 igcm_n2,& 34 igcm_n2,igcm_ch4_gas,igcm_ch4_ice,igcm_haze,& 35 igcm_co_gas,igcm_co_ice,igcm_prec_haze,lw_n2,& 35 36 alpha_lift, alpha_devil, qextrhor, & 36 37 nesp, is_chim, is_condensable,constants_epsi_generic … … 45 46 use comcstfi_mod, only: pi, g, rcp, r, rad, mugaz, cpp 46 47 use time_phylmdz_mod, only: daysec 47 use callkeys_mod, only: fast,albedo_spectral_mode, calladj, calldifv, &48 use callkeys_mod, only: albedo_spectral_mode, calladj, calldifv, & 48 49 callrad, callsoil, nosurf, & 49 50 aerohaze, corrk, diagdtau,& … … 51 52 icetstep, intheat, iradia, kastprof, & 52 53 lwrite, mass_redistrib, meanOLR, & 54 fast,fasthaze,haze,metcloud,monoxcloud,& 53 55 n2cond,nearn2cond, noseason_day, & 56 fast, carbox, methane, UseVdifcPlutold, & 57 aerohaze, haze_proffix, triton, paleo, & 54 58 season, sedimentation,generic_condensation, & 55 aerohaze, haze_proffix, &56 59 specOLR, & 57 60 startphy_file, testradtimes, & … … 64 67 use callcorrk_mod, only: callcorrk 65 68 use vdifc_mod, only: vdifc 69 use vdifc_pluto_mod, only: vdifc_pluto 66 70 use turbdiff_mod, only: turbdiff 67 71 use turb_mod, only : q2,sensibFlux,turb_resolved … … 115 119 ! II.a Option 1 : Call correlated-k radiative transfer scheme. 116 120 ! II.b Option 2 : Call Newtonian cooling scheme. 117 ! II. cOption 3 : Atmosphere has no radiative effect.121 ! II.! Option 3 : Atmosphere has no radiative effect. 118 122 ! 119 123 ! III. Vertical diffusion (turbulent mixing) : … … 250 254 !$OMP THREADPRIVATE(day_ini,icount) 251 255 256 REAL,save :: acond,bcond 257 REAL, save :: tcond1p4Pa 258 DATA tcond1p4Pa/38/ 259 260 252 261 ! Local variables : 253 262 ! ----------------- … … 270 279 real zzlay(ngrid,nlayer) ! Altitude at the middle of the atmospheric layers. 271 280 real zzlev(ngrid,nlayer+1) ! Altitude at the atmospheric layer boundaries. 281 272 282 273 283 ! VARIABLES for the thermal plume model (AF24: deleted) … … 351 361 REAL flym_sol(ngrid) ! Incident Solar flux Lyman alpha ph.m-2.s-1 352 362 REAL flym_ipm(ngrid) ! Incident IPM (Interplanetary) flux Lyman alpha ph.m-2.s-1 363 REAL zfluxuv ! Lyman alpha flux at 1AU 353 364 354 365 … … 376 387 real zflubid(ngrid) 377 388 real zplanck(ngrid),zpopsk(ngrid,nlayer) 389 REAL zdum1(ngrid,nlayer) 390 REAL zdum2(ngrid,nlayer) 378 391 real ztim1,ztim2,ztim3, z1,z2 379 392 real ztime_fin … … 721 734 end if 722 735 723 call orbite(zls,dist_star,declin,right_ascen) 736 737 ! Get Lyman alpha flux at specific Ls 738 if (haze) then 739 call lymalpha(zls,zfluxuv) 740 print*, 'Haze lyman-alpha zls,zfluxuv=',zls,zfluxuv 741 end if 742 743 744 IF (triton) then 745 CALL orbitetriton(zls,zday,dist_star,declin) 746 ELSE 747 call orbite(zls,dist_star,declin,right_ascen) 748 ENDIF 749 724 750 725 751 if (diurnal) then … … 768 794 ! w = F / (rho*area) and rho = P/(r*T) 769 795 ! But first linearly interpolate mass flux to mid-layers 770 if (.not.fast) then 796 if (.not.fast) then 771 797 do l=1,nlayer-1 772 798 pw(1:ngrid,l)=0.5*(flxw(1:ngrid,l)+flxw(1:ngrid,l+1)) … … 810 836 endif 811 837 838 ! AF24: TODO insert surfprop for pluto & triton around here 839 812 840 if (callrad) then 813 841 if( mod(icount-1,iradia).eq.0.or.lastcall) then … … 910 938 else 911 939 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 912 ! II. cAtmosphere has no radiative effect940 ! II.! Atmosphere has no radiative effect 913 941 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 914 942 fluxtop_dn(1:ngrid) = fract(1:ngrid)*mu0(1:ngrid)*Fat1AU/dist_star**2 … … 988 1016 taux,tauy) 989 1017 990 else 1018 else if (UseVdifcPlutold) then 1019 zflubid(1:ngrid)=fluxrad(1:ngrid)+fluxgrd(1:ngrid) 1020 1021 ! Calling vdif (Martian version WITH N2 condensation) 1022 CALL vdifc_pluto(ngrid,nlayer,nq,zpopsk, & 1023 ptimestep,capcal,lwrite, & 1024 pplay,pplev,zzlay,zzlev,z0, & 1025 pu,pv,zh,pq,pt,tsurf,emis,qsurf, & 1026 zdum1,zdum2,zdh,pdq,pdt,zflubid, & 1027 zdudif,zdvdif,zdhdif,zdtsdif,q2, & 1028 zdqdif,zdqsdif,qsat_ch4,qsat_ch4_l1) !,zq1temp_ch4,qsat_ch4) 1029 1030 pdv(1:ngrid,1:nlayer)=pdv(1:ngrid,1:nlayer)+zdvdif(1:ngrid,1:nlayer) 1031 pdu(1:ngrid,1:nlayer)=pdu(1:ngrid,1:nlayer)+zdudif(1:ngrid,1:nlayer) 1032 pdt(1:ngrid,1:nlayer)=pdt(1:ngrid,1:nlayer)+zdhdif(1:ngrid,1:nlayer)*zpopsk(1:ngrid,1:nlayer) 1033 1034 zdtdif(1:ngrid,1:nlayer)=zdhdif(1:ngrid,1:nlayer)*zpopsk(1:ngrid,1:nlayer) ! for diagnostic only 1035 zdtsurf(1:ngrid)=zdtsurf(1:ngrid)+zdtsdif(1:ngrid) 1036 1037 bcond=1./tcond1p4Pa 1038 acond=r/lw_n2 1039 1040 if (tracer) then 1041 pdq(1:ngrid,1:nlayer,1:nq)=pdq(1:ngrid,1:nlayer,1:nq)+ zdqdif(1:ngrid,1:nlayer,1:nq) 1042 dqsurf(1:ngrid,1:nq)=dqsurf(1:ngrid,1:nq) + zdqsdif(1:ngrid,1:nq) 1043 end if ! of if (tracer) 1044 1045 !------------------------------------------------------------------ 1046 ! test methane conservation 1047 ! if(methane)then 1048 ! call testconserv(ngrid,nlayer,nq,igcm_ch4_gas,igcm_ch4_ice, 1049 ! & ptimestep,pplev,zdqdif,zdqsdif,'CH4',' vdifc ') 1050 ! endif ! methane 1051 !------------------------------------------------------------------ 1052 ! test CO conservation 1053 ! if(carbox)then 1054 ! call testconserv(ngrid,nlayer,nq,igcm_co_gas,igcm_co_ice, 1055 ! & ptimestep,pplev,zdqdif,zdqsdif,'CO ',' vdifc ') 1056 ! endif ! carbox 1057 !------------------------------------------------------------------ 1058 1059 else ! if (UseVdifcPlutold) 991 1060 992 1061 zdh(1:ngrid,1:nlayer)=pdt(1:ngrid,1:nlayer)/zpopsk(1:ngrid,1:nlayer) … … 1167 1236 if (tracer) then 1168 1237 1169 ! --------------------- 1170 ! VI.1. Water and ice !AF24: removed 1171 ! --------------------- 1172 ! ------------------------- 1173 ! VI.2. Photochemistry !AF24: removed 1174 ! ------------------------- 1238 1239 1240 ! 7a. Methane, CO, and ice 1241 ! --------------------------------------- 1242 ! Methane ice condensation in the atmosphere 1243 ! ---------------------------------------- 1244 zdqch4cloud(:,:,:)=0. 1245 if ((methane).and.(metcloud).and.(.not.fast)) THEN 1246 call ch4cloud(ngrid,nlayer,naerkind,ptimestep, & 1247 pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt, & 1248 pq,pdq,zdqch4cloud,zdqsch4cloud,zdtch4cloud, & 1249 nq,rice_ch4) 1250 1251 DO l=1,nlayer 1252 DO ig=1,ngrid 1253 pdq(ig,l,igcm_ch4_gas)=pdq(ig,l,igcm_ch4_gas)+ & 1254 zdqch4cloud(ig,l,igcm_ch4_gas) 1255 pdq(ig,l,igcm_ch4_ice)=pdq(ig,l,igcm_ch4_ice)+ & 1256 zdqch4cloud(ig,l,igcm_ch4_ice) 1257 ENDDO 1258 ENDDO 1259 1260 ! Increment methane ice surface tracer tendency 1261 DO ig=1,ngrid 1262 dqsurf(ig,igcm_ch4_ice)=dqsurf(ig,igcm_ch4_ice)+ & 1263 zdqsch4cloud(ig,igcm_ch4_ice) 1264 ENDDO 1265 1266 ! update temperature tendancy 1267 DO ig=1,ngrid 1268 DO l=1,nlayer 1269 pdt(ig,l)=pdt(ig,l)+zdtch4cloud(ig,l) 1270 ENDDO 1271 ENDDO 1272 else 1273 rice_ch4(:,:)=0 ! initialization needed for callsedim 1274 end if 1275 1276 ! --------------------------------------- 1277 ! CO ice condensation in the atmosphere 1278 ! ---------------------------------------- 1279 zdqcocloud(:,:,:)=0. 1280 IF ((carbox).and.(monoxcloud).and.(.not.fast)) THEN 1281 call cocloud(ngrid,nlayer,naerkind,ptimestep, & 1282 pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt, & 1283 pq,pdq,zdqcocloud,zdqscocloud,zdtcocloud, & 1284 nq,rice_co,qsurf(1,igcm_n2),dqsurf(1,igcm_n2)) 1285 1286 DO l=1,nlayer 1287 DO ig=1,ngrid 1288 pdq(ig,l,igcm_co_gas)=pdq(ig,l,igcm_co_gas)+ & 1289 zdqcocloud(ig,l,igcm_co_gas) 1290 pdq(ig,l,igcm_co_ice)=pdq(ig,l,igcm_co_ice)+ & 1291 zdqcocloud(ig,l,igcm_co_ice) 1292 ENDDO 1293 ENDDO 1294 1295 ! Increment CO ice surface tracer tendency 1296 DO ig=1,ngrid 1297 dqsurf(ig,igcm_co_ice)=dqsurf(ig,igcm_co_ice)+ & 1298 zdqscocloud(ig,igcm_co_ice) 1299 ENDDO 1300 1301 ! update temperature tendancy 1302 DO ig=1,ngrid 1303 DO l=1,nlayer 1304 pdt(ig,l)=pdt(ig,l)+zdtcocloud(ig,l) 1305 ENDDO 1306 ENDDO 1307 ELSE 1308 rice_co(:,:)=0 ! initialization needed for callsedim 1309 END IF ! of IF (carbox) 1310 1311 !------------------------------------------------------------------ 1312 ! test methane conservation 1313 ! if(methane)then 1314 ! call testconserv(ngrid,nlayer,nq,igcm_ch4_gas,igcm_ch4_ice, 1315 ! & ptimestep,pplev,zdqch4cloud,zdqsch4cloud,'CH4','ch4clou') 1316 ! endif ! methane 1317 !------------------------------------------------------------------ 1318 ! test CO conservation 1319 ! if(carbox)then 1320 ! call testconserv(ngrid,nlayer,nq,igcm_co_gas,igcm_co_ice, 1321 ! & ptimestep,pplev,zdqcocloud,zdqscocloud,'CO ','cocloud') 1322 ! endif ! carbox 1323 !------------------------------------------------------------------ 1324 1325 ! 7b. Haze particle production 1326 ! ------------------- 1327 IF (haze) THEN 1328 1329 zdqphot_prec(:,:)=0. 1330 zdqphot_ch4(:,:)=0. 1331 ! Forcing to a fixed haze profile if haze_proffix 1332 if (haze_proffix.and.i_haze.gt.0.) then 1333 call haze_prof(ngrid,nlayer,zzlay,pplay,pt, & 1334 reffrad,profmmr) 1335 zdqhaze(:,:,i_haze)=(profmmr(:,:)-pq(:,:,igcm_haze)) & 1336 /ptimestep 1337 else 1338 call hazecloud(ngrid,nlayer,nq,ptimestep, & 1339 pplay,pplev,pq,pdq,dist_star,mu0,zfluxuv,zdqhaze, & 1340 zdqphot_prec,zdqphot_ch4,zdqconv_prec,declin) 1341 endif 1342 1343 DO iq=1, nq ! should be updated 1344 DO l=1,nlayer 1345 DO ig=1,ngrid 1346 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqhaze(ig,l,iq) 1347 ENDDO 1348 ENDDO 1349 ENDDO 1350 1351 ENDIF 1352 1353 IF (fast.and.fasthaze) THEN 1354 call prodhaze(ngrid,nlayer,nq,ptimestep,pplev,pq,pdq,dist_star, & 1355 mu0,declin,zdqprodhaze,zdqsprodhaze,gradflux,fluxbot, & 1356 fluxlym_sol_bot,fluxlym_ipm_bot,flym_sol,flym_ipm) 1357 1358 DO ig=1,ngrid 1359 pdq(ig,1,igcm_ch4_gas)=pdq(ig,1,igcm_ch4_gas)+ & 1360 zdqprodhaze(ig,igcm_ch4_gas) 1361 pdq(ig,1,igcm_prec_haze)=pdq(ig,1,igcm_prec_haze)+ & 1362 zdqprodhaze(ig,igcm_prec_haze) 1363 pdq(ig,1,igcm_haze)=abs(pdq(ig,1,igcm_haze)+ & 1364 zdqprodhaze(ig,igcm_haze)) 1365 qsurf(ig,igcm_haze)= qsurf(ig,igcm_haze)+ & 1366 zdqsprodhaze(ig)*ptimestep 1367 ENDDO 1368 1369 ENDIF 1370 1371 1372 1175 1373 ! ------------------------- 1176 1374 ! VI.3. Aerosol particles … … 1476 1674 enddo 1477 1675 1478 if (aerohaze) then1479 ! Generalised for arbitrary aerosols now. By LK1480 reffcol(1:ngrid,1:naerkind)=0.01481 ! call n2_reffrad(ngrid,nlayer,nq,zq,reffrad(1,1,iaero_haze))1482 if (haze_proffix.and.i_haze.gt.0.) then1483 call haze_prof(ngrid,nlayer,zzlay,pplay,pt, &1484 reffrad,profmmr)1485 zdqhaze(:,:,i_haze)=(profmmr(:,:)-pq(:,:,igcm_n2)) & ! AF: TODO: replace by igcm_haze?1486 /ptimestep1487 else1488 !! AF: TODO import from pluto.old?1489 ! call hazecloud(ngrid,nlayer,nq,ptimestep,&1490 ! pplay,pplev,pq,pdq,dist_sol,mu0,zfluxuv,zdqhaze,&1491 ! zdqphot_prec,zdqphot_ch4,zdqconv_prec,declin)1492 endif1493 1494 DO iq=1, nq ! should be updated1495 DO l=1,nlayer1496 DO ig=1,ngrid1497 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqhaze(ig,l,iq)1498 ENDDO1499 ENDDO1500 ENDDO1501 endif ! end of aerohaze1502 1676 endif ! end of 'tracer' 1503 1677 -
trunk/LMDZ.PLUTO/libf/phypluto/tracer_h.F90
r3195 r3237 87 87 integer,save :: igcm_eddy5e8 88 88 89 !$OMP THREADPRIVATE(igcm_co_gas,igcm_n2,igcm_ar,igcm_ch4_gas,igcm_ar_n2, &igcm_ch4_ice,igcm_co_ice,igcm_prec_haze,igcm_haze,igcm_haze10,igcm_haze30,igcm_haze50,igcm_haze100,igcm_eddy1e6,igcm_eddy1e7,igcm_eddy5e7,igcm_eddy1e8,igcm_eddy5e8)89 !$OMP THREADPRIVATE(igcm_co_gas,igcm_n2,igcm_ar,igcm_ch4_gas,igcm_ar_n2,igcm_ch4_ice,igcm_co_ice,igcm_prec_haze,igcm_haze,igcm_haze10,igcm_haze30,igcm_haze50,igcm_haze100,igcm_eddy1e6,igcm_eddy1e7,igcm_eddy5e7,igcm_eddy1e8,igcm_eddy5e8) 90 90 91 91 end module tracer_h
Note: See TracChangeset
for help on using the changeset viewer.