Changeset 3232 for trunk/LMDZ.GENERIC
- Timestamp:
- Feb 21, 2024, 5:45:11 PM (9 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.GENERIC/libf/phystd/physiq_mod.F90
r3204 r3232 1 1 module physiq_mod 2 2 3 3 implicit none 4 4 5 5 contains 6 6 7 7 subroutine physiq(ngrid,nlayer,nq, & 8 8 firstcall,lastcall, & … … 14 14 15 15 !! 16 use write_field_phy, only: Writefield_phy 16 use write_field_phy, only: Writefield_phy 17 17 !! 18 use ioipsl_getin_p_mod, only: getin_p 18 use ioipsl_getin_p_mod, only: getin_p 19 19 use radinc_h, only : L_NSPECTI,L_NSPECTV,naerkind, corrkdir, banddir 20 20 use watercommon_h, only : RLVTT, Psat_water,epsi,su_watercycle, RV, T_h2o_ice_liq … … 80 80 use turb_mod, only : q2,sensibFlux,turb_resolved 81 81 use mass_redistribution_mod, only: mass_redistribution 82 use condensation_generic_mod, only: condensation_generic 82 use condensation_generic_mod, only: condensation_generic 83 83 use datafile_mod, only: datadir 84 84 #ifndef MESOSCALE … … 98 98 #endif 99 99 100 #ifdef CPP_XIOS 100 #ifdef CPP_XIOS 101 101 use xios_output_mod, only: initialize_xios_output, & 102 102 update_xios_timestep, & … … 109 109 110 110 !================================================================== 111 ! 111 ! 112 112 ! Purpose 113 113 ! ------- … … 199 199 ! Frederic Hourdin 15/10/93 200 200 ! Francois Forget 1994 201 ! Christophe Hourdin 02/1997 201 ! Christophe Hourdin 02/1997 202 202 ! Subroutine completely rewritten by F. Forget (01/2000) 203 203 ! Water ice clouds: Franck Montmessin (update 06/2003) 204 204 ! Radiatively active tracers: J.-B. Madeleine (10/2008-06/2009) 205 205 ! New correlated-k radiative scheme: R. Wordsworth (2009) 206 ! Many specifically Martian subroutines removed: R. Wordsworth (2009) 206 ! Many specifically Martian subroutines removed: R. Wordsworth (2009) 207 207 ! Improved water cycle: R. Wordsworth / B. Charnay (2010) 208 208 ! To F90: R. Wordsworth (2010) … … 229 229 integer,intent(in) :: nlayer ! Number of atmospheric layers. 230 230 integer,intent(in) :: nq ! Number of tracers. 231 231 232 232 logical,intent(in) :: firstcall ! Signals first call to physics. 233 233 logical,intent(in) :: lastcall ! Signals last call to physics. 234 234 235 235 real,intent(in) :: pday ! Number of elapsed sols since reference Ls=0. 236 236 real,intent(in) :: ptime ! "Universal time", given as fraction of sol (e.g.: 0.5 for noon). … … 265 265 ! ----------------- 266 266 267 ! Aerosol (dust or ice) extinction optical depth at reference wavelength 267 ! Aerosol (dust or ice) extinction optical depth at reference wavelength 268 268 ! for the "naerkind" optically active aerosols: 269 269 … … 276 276 integer l,ig,ierr,iq,nw,isoil,iesp, igcm_generic_vap, igcm_generic_ice 277 277 logical call_ice_vap_generic ! to call only one time the ice/vap pair of a tracer 278 278 279 279 real zls ! Solar longitude (radians). 280 280 real zlss ! Sub solar point longitude (radians). … … 284 284 285 285 ! VARIABLES for the thermal plume model 286 286 287 287 real f(ngrid) ! Mass flux norm 288 288 real fm(ngrid,nlayer+1) ! Mass flux … … 297 297 real zw2(ngrid,nlayer+1) ! Vertical speed 298 298 real zw2_bis(ngrid,nlayer) ! Recasted zw2 299 299 300 300 ! TENDENCIES due to various processes : 301 301 … … 306 306 real zdtsdif(ngrid) ! Turbdiff/vdifc routines. 307 307 real zdtsurf_hyd(ngrid) ! Hydrol routine. 308 309 ! For Atmospheric Temperatures : (K/s) 308 309 ! For Atmospheric Temperatures : (K/s) 310 310 real dtlscale(ngrid,nlayer) ! Largescale routine. 311 real dt_generic_condensation(ngrid,nlayer) ! condensation_generic routine. 311 real dt_generic_condensation(ngrid,nlayer) ! condensation_generic routine. 312 312 real zdtc(ngrid,nlayer) ! Condense_co2 routine. 313 313 real zdtdif(ngrid,nlayer) ! Turbdiff/vdifc routines. … … 320 320 real zdtsw1(ngrid,nlayer), zdtlw1(ngrid,nlayer) ! Callcorrk routine. 321 321 real zdtchim(ngrid,nlayer) ! Calchim routine. 322 322 323 323 ! For Surface Tracers : (kg/m2/s) 324 324 real dqsurf(ngrid,nq) ! Cumulated tendencies. … … 332 332 real reevap_precip(ngrid) ! re-evaporation flux of precipitation (integrated over the atmospheric column) 333 333 real reevap_precip_generic(ngrid,nq) 334 334 335 335 ! For Tracers : (kg/kg_of_air/s) 336 336 real zdqc(ngrid,nlayer,nq) ! Condense_co2 routine. … … 355 355 REAL array_zero1(ngrid) 356 356 REAL array_zero2(ngrid,nlayer) 357 357 358 358 ! For Winds : (m/s/s) 359 359 real zdvadj(ngrid,nlayer), zduadj(ngrid,nlayer) ! Convadj routine. … … 363 363 real zdhdif(ngrid,nlayer) ! Turbdiff/vdifc routines. 364 364 real zdhadj(ngrid,nlayer) ! Convadj routine. 365 365 366 366 ! For Pressure and Mass : 367 367 real zdmassmr(ngrid,nlayer) ! Atmospheric Mass tendency for mass_redistribution (kg_of_air/m2/s). … … 369 369 real zdpsrfmr(ngrid) ! Pressure tendency for mass_redistribution routine (Pa/s). 370 370 371 372 371 372 373 373 ! Local variables for LOCAL CALCULATIONS: 374 374 ! --------------------------------------- … … 395 395 real vmr(ngrid,nlayer) ! volume mixing ratio 396 396 real time_phys 397 397 398 398 real ISR,ASR,OLR,GND,DYN,GSR,Ts1,Ts2,Ts3,TsS ! for Diagnostic. 399 399 400 400 real qcol(ngrid,nq) ! Tracer Column Mass (kg/m2). 401 401 … … 410 410 real,save :: dEtotSW, dEtotsSW, dEtotLW, dEtotsLW 411 411 !$OMP THREADPRIVATE(dEtotSW, dEtotsSW, dEtotLW, dEtotsLW) 412 412 413 413 !JL12 conservation test for mean flow kinetic energy has been disabled temporarily 414 414 415 real dtmoist_max,dtmoist_min 415 real dtmoist_max,dtmoist_min 416 416 real dItot, dItot_tmp, dVtot, dVtot_tmp 417 417 … … 437 437 438 438 logical clearsky ! For double radiative transfer call. By BC 439 439 440 440 ! For Clear Sky Case. 441 441 real fluxsurfabs_sw1(ngrid) ! For SW/LW flux. … … 466 466 real :: flux_sens_lat(ngrid) 467 467 real :: qsurfint(ngrid,nq) 468 #ifdef MESOSCALE 468 #ifdef MESOSCALE 469 469 REAL :: lsf_dt(nlayer) 470 470 REAL :: lsf_dq(nlayer) … … 474 474 logical, save :: check_physics_inputs=.false. 475 475 logical, save :: check_physics_outputs=.false. 476 !$OPM THREADPRIVATE(check_physics_inputs,check_physics_outputs) 476 !$OPM THREADPRIVATE(check_physics_inputs,check_physics_outputs) 477 477 478 478 ! Misc 479 479 character*2 :: str2 480 character(len=10) :: tmp1 480 character(len=10) :: tmp1 481 481 character(len=10) :: tmp2 482 482 !================================================================================================== … … 534 534 ! Read 'startfi.nc' file. 535 535 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 536 #ifndef MESOSCALE 536 #ifndef MESOSCALE 537 537 call phyetat0(startphy_file, & 538 538 ngrid,nlayer,"startfi.nc",0,0,nsoilmx,nq, & … … 541 541 rnat,pctsrf_sic,tslab, tsea_ice,sea_ice) 542 542 543 #else 543 #else 544 544 545 545 day_ini = pday … … 555 555 tsoil(1:ngrid,isoil)=tsurf(1:ngrid) 556 556 enddo 557 if (is_master) write(*,*) "Physiq: initializing day_ini to pda t!"557 if (is_master) write(*,*) "Physiq: initializing day_ini to pday !" 558 558 day_ini=pday 559 559 endif … … 569 569 write (*,*) 'In physiq day_ini =', day_ini 570 570 571 ! Initialize albedo calculation. 571 ! Initialize albedo calculation. 572 572 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 573 573 albedo(:,:)=0.0 … … 575 575 albedo_snow_SPECTV(:)=0.0 576 576 albedo_co2_ice_SPECTV(:)=0.0 577 call surfini(ngrid,nq,qsurf,albedo,albedo_bareground,albedo_snow_SPECTV,albedo_co2_ice_SPECTV) 578 579 ! Initialize orbital calculation. 577 call surfini(ngrid,nq,qsurf,albedo,albedo_bareground,albedo_snow_SPECTV,albedo_co2_ice_SPECTV) 578 579 ! Initialize orbital calculation. 580 580 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 581 581 call iniorbit(apoastr,periastr,year_day,peri_day,obliquit) … … 596 596 597 597 !! call ini_surf_heat_transp_mod() 598 598 599 599 knindex(:) = 0 600 600 knon = 0 … … 620 620 ! ~~~~~~~~~~~~~~~~ 621 621 if (callsoil) then 622 622 623 623 call soil(ngrid,nsoilmx,firstcall,lastcall,inertiedat, & 624 624 ptimestep,tsurf,tsoil,capcal,fluxgrd) … … 639 639 640 640 else ! else of 'callsoil'. 641 641 642 642 print*,'WARNING! Thermal conduction in the soil turned off' 643 643 capcal(:)=1.e6 644 644 fluxgrd(:)=intheat 645 645 print*,'Flux from ground = ',intheat,' W m^-2' 646 646 647 647 endif ! end of 'callsoil'. 648 648 649 649 icount=1 650 650 … … 653 653 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 654 654 if (.not.ok_slab_ocean) then 655 655 656 656 rnat(:)=1. 657 657 if (.not.nosurf) then ! inertiedat only defined if there is a surface … … 691 691 endif 692 692 693 if(meanOLR)then 694 call system('rm -f rad_bal.out') ! to record global radiative balance. 695 call system('rm -f tem_bal.out') ! to record global mean/max/min temperatures. 693 if(meanOLR)then 694 call system('rm -f rad_bal.out') ! to record global radiative balance. 695 call system('rm -f tem_bal.out') ! to record global mean/max/min temperatures. 696 696 call system('rm -f h2o_bal.out') ! to record global hydrological balance. 697 697 endif 698 698 699 699 700 watertest=.false. 700 watertest=.false. 701 701 if(water)then ! Initialize variables for water cycle 702 702 703 703 if(enertest)then 704 704 watertest = .true. … … 711 711 metallicity=0.0 ! default value --- is not used here but necessary to call function Psat_generic 712 712 call getin_p("metallicity",metallicity) ! --- is not used here but necessary to call function Psat_generic 713 713 714 714 ! Set some parameters for the thermal plume model 715 715 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ … … 731 731 732 732 !! call WriteField_phy("post_physdem_qsurf",qsurf(1:ngrid,igcm_h2o_vap),1) 733 #endif 734 if (corrk) then 735 ! We initialise the spectral grid here instead of 736 ! at firstcall of callcorrk so we can output XspecIR, XspecVI 733 #endif 734 if (corrk) then 735 ! We initialise the spectral grid here instead of 736 ! at firstcall of callcorrk so we can output XspecIR, XspecVI 737 737 ! when using Dynamico 738 738 print*, "physiq_mod: Correlated-k data base folder:",trim(datadir) … … 757 757 year_day,presnivs,pseudoalt,WNOI,WNOV) 758 758 #endif 759 759 760 760 !! call WriteField_phy("post_xios_qsurf",qsurf(1:ngrid,igcm_h2o_vap),1) 761 761 … … 764 764 765 765 !! call WriteField_phy("post_firstcall_qsurf",qsurf(1:ngrid,igcm_h2o_vap),1) 766 !! call writediagfi(ngrid,"firstcall_post_qsurf"," "," ",2,qsurf(1:ngrid,igcm_h2o_vap)) 766 !! call writediagfi(ngrid,"firstcall_post_qsurf"," "," ",2,qsurf(1:ngrid,igcm_h2o_vap)) 767 767 768 768 if (check_physics_inputs) then … … 778 778 ! ------------------------------------------------------ 779 779 780 #ifdef CPP_XIOS 780 #ifdef CPP_XIOS 781 781 ! update XIOS time/calendar 782 782 call update_xios_timestep 783 #endif 783 #endif 784 784 785 785 ! Initialize various variables 786 786 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 787 787 788 788 if ( .not.nearco2cond ) then 789 789 pdt(1:ngrid,1:nlayer) = 0.0 790 endif 790 endif 791 791 zdtsurf(1:ngrid) = 0.0 792 792 pdq(1:ngrid,1:nlayer,1:nq) = 0.0 … … 795 795 pdv(1:ngrid,1:nlayer) = 0.0 796 796 pdpsrf(1:ngrid) = 0.0 797 zflubid(1:ngrid) = 0.0 797 zflubid(1:ngrid) = 0.0 798 798 flux_sens_lat(1:ngrid) = 0.0 799 799 taux(1:ngrid) = 0.0 … … 811 811 812 812 call orbite(zls,dist_star,declin,right_ascen) 813 813 814 814 if (tlocked) then 815 815 zlss=Mod(-(2.*pi*(zday/year_day)*nres - right_ascen),2.*pi) … … 818 818 else if(diurnal .eqv. .false.) then 819 819 zlss=9999. 820 endif 820 endif 821 821 822 822 823 823 ! Compute variations of g with latitude (oblate case). 824 824 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 825 if (oblate .eqv. .false.) then 826 glat(:) = g 827 else if (flatten .eq. 0.0 .or. J2 .eq. 0.0 .or. Rmean .eq. 0.0 .or. MassPlanet .eq. 0.0) then 825 if (oblate .eqv. .false.) then 826 glat(:) = g 827 else if (flatten .eq. 0.0 .or. J2 .eq. 0.0 .or. Rmean .eq. 0.0 .or. MassPlanet .eq. 0.0) then 828 828 print*,'I need values for flatten, J2, Rmean and MassPlanet to compute glat (else set oblate=.false.)' 829 829 call abort … … 831 831 gmplanet = MassPlanet*grav*1e24 832 832 do ig=1,ngrid 833 glat(ig)= gmplanet/(Rmean**2) * (1.D0 + 0.75 *J2 - 2.0*flatten/3. + (2.*flatten - 15./4.* J2) * cos(2. * (pi/2. - latitude(ig)))) 833 glat(ig)= gmplanet/(Rmean**2) * (1.D0 + 0.75 *J2 - 2.0*flatten/3. + (2.*flatten - 15./4.* J2) * cos(2. * (pi/2. - latitude(ig)))) 834 834 end do 835 835 endif … … 838 838 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 839 839 zzlay(1:ngrid,1:nlayer)=pphi(1:ngrid,1:nlayer) 840 do l=1,nlayer 840 do l=1,nlayer 841 841 zzlay(1:ngrid,l)= zzlay(1:ngrid,l)/glat(1:ngrid) 842 842 enddo … … 850 850 zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2) 851 851 enddo 852 enddo 852 enddo 853 853 854 854 !Altitude of top interface (nlayer+1), using the thicknesss of the level below the top one. LT22 855 855 856 856 zzlev(1:ngrid,nlayer+1) = 2*zzlev(1:ngrid,nlayer)-zzlev(1:ngrid,nlayer-1) 857 857 … … 859 859 ! Note : Potential temperature calculation may not be the same in physiq and dynamic... 860 860 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 861 do l=1,nlayer 861 do l=1,nlayer 862 862 do ig=1,ngrid 863 863 zpopsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**rcp … … 894 894 if(photochem) then 895 895 call concentrations(ngrid,nlayer,nq,pplay,pt,pdt,pq,pdq,ptimestep) 896 endif 896 endif 897 897 #endif 898 898 … … 928 928 endif 929 929 930 endif 930 endif 931 931 932 932 if (callrad) then 933 933 if( mod(icount-1,iradia).eq.0.or.lastcall) then 934 935 ! Eclipse incoming sunlight (e.g. Saturn ring shadowing). 934 935 ! Eclipse incoming sunlight (e.g. Saturn ring shadowing). 936 936 if(rings_shadow) then 937 937 call call_rings(ngrid, ptime, pday, diurnal) 938 endif 938 endif 939 939 940 940 !! call writediagfi(ngrid,"corrk_pre_dqsurf"," "," ",2,dqsurf(1:ngrid,igcm_h2o_vap)) 941 !! call writediagfi(ngrid,"corrk_pre_qsurf"," "," ",2,qsurf(1:ngrid,igcm_h2o_vap)) 941 !! call writediagfi(ngrid,"corrk_pre_qsurf"," "," ",2,qsurf(1:ngrid,igcm_h2o_vap)) 942 942 943 943 944 944 if (corrk) then 945 945 946 946 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 947 947 ! II.a Call correlated-k radiative transfer scheme … … 952 952 endif 953 953 if(water) then 954 muvar(1:ngrid,1:nlayer)=mugaz/(1.e0+(1.e0/epsi-1.e0)*pq(1:ngrid,1:nlayer,igcm_h2o_vap)) 955 muvar(1:ngrid,nlayer+1)=mugaz/(1.e0+(1.e0/epsi-1.e0)*pq(1:ngrid,nlayer,igcm_h2o_vap)) 954 muvar(1:ngrid,1:nlayer)=mugaz/(1.e0+(1.e0/epsi-1.e0)*pq(1:ngrid,1:nlayer,igcm_h2o_vap)) 955 muvar(1:ngrid,nlayer+1)=mugaz/(1.e0+(1.e0/epsi-1.e0)*pq(1:ngrid,nlayer,igcm_h2o_vap)) 956 956 ! take into account water effect on mean molecular weight 957 957 elseif(generic_condensation) then … … 959 959 960 960 call generic_tracer_index(nq,iq,igcm_generic_vap,igcm_generic_ice,call_ice_vap_generic) 961 961 962 962 if (call_ice_vap_generic) then ! to call only one time the ice/vap pair of a tracer 963 963 964 964 epsi_generic=constants_epsi_generic(iq) 965 965 966 muvar(1:ngrid,1:nlayer)=mugaz/(1.e0+(1.e0/epsi_generic-1.e0)*pq(1:ngrid,1:nlayer,igcm_generic_vap)) 967 muvar(1:ngrid,nlayer+1)=mugaz/(1.e0+(1.e0/epsi_generic-1.e0)*pq(1:ngrid,nlayer,igcm_generic_vap)) 966 muvar(1:ngrid,1:nlayer)=mugaz/(1.e0+(1.e0/epsi_generic-1.e0)*pq(1:ngrid,1:nlayer,igcm_generic_vap)) 967 muvar(1:ngrid,nlayer+1)=mugaz/(1.e0+(1.e0/epsi_generic-1.e0)*pq(1:ngrid,nlayer,igcm_generic_vap)) 968 968 969 969 endif 970 end do ! do iq=1,nq loop on tracers 970 end do ! do iq=1,nq loop on tracers 971 971 ! take into account generic condensable specie (GCS) effect on mean molecular weight 972 972 973 973 else 974 974 muvar(1:ngrid,1:nlayer+1)=mugaz 975 endif 976 975 endif 976 977 977 978 978 if(ok_slab_ocean) then 979 tsurf2(:)=tsurf(:) 979 tsurf2(:)=tsurf(:) 980 980 do ig=1,ngrid 981 981 if (nint(rnat(ig))==0) then … … 984 984 enddo 985 985 endif !(ok_slab_ocean) 986 986 987 987 ! standard callcorrk 988 988 clearsky=.false. … … 995 995 int_dtaui,int_dtauv, & 996 996 tau_col,cloudfrac,totcloudfrac, & 997 clearsky,firstcall,lastcall) 997 clearsky,firstcall,lastcall) 998 998 999 999 !GG (feb2021): Option to "artificially" decrease the raditive time scale in 1000 1000 !the deep atmosphere press > 0.1 bar. Suggested by MT. 1001 !! COEFF_RAD to be "tuned" to facilitate convergence of tendency 1002 1001 !! COEFF_RAD to be "tuned" to facilitate convergence of tendency 1002 1003 1003 !coeff_rad=0. ! 0 values, it doesn't accelerate the convergence 1004 1004 !coeff_rad=0.5 1005 !coeff_rad=1. 1005 !coeff_rad=1. 1006 1006 !do l=1, nlayer 1007 1007 ! do ig=1,ngrid … … 1013 1013 !enddo 1014 1014 1015 ! Option to call scheme once more for clear regions 1015 ! Option to call scheme once more for clear regions 1016 1016 if(CLFvarying)then 1017 1017 … … 1027 1027 tau_col1,cloudfrac,totcloudfrac, & 1028 1028 clearsky,firstcall,lastcall) 1029 clearsky = .false. ! just in case. 1029 clearsky = .false. ! just in case. 1030 1030 1031 1031 ! Sum the fluxes and heating rates from cloudy/clear cases 1032 1032 do ig=1,ngrid 1033 1033 tf=totcloudfrac(ig) 1034 ntf=1.-tf 1034 ntf=1.-tf 1035 1035 fluxsurf_lw(ig) = ntf*fluxsurf_lw1(ig) + tf*fluxsurf_lw(ig) 1036 1036 fluxsurf_sw(ig) = ntf*fluxsurf_sw1(ig) + tf*fluxsurf_sw(ig) … … 1040 1040 fluxabs_sw(ig) = ntf*fluxabs_sw1(ig) + tf*fluxabs_sw(ig) 1041 1041 tau_col(ig) = ntf*tau_col1(ig) + tf*tau_col(ig) 1042 1042 1043 1043 zdtlw(ig,1:nlayer) = ntf*zdtlw1(ig,1:nlayer) + tf*zdtlw(ig,1:nlayer) 1044 1044 zdtsw(ig,1:nlayer) = ntf*zdtsw1(ig,1:nlayer) + tf*zdtsw(ig,1:nlayer) 1045 1045 1046 OSR_nu(ig,1:L_NSPECTV) = ntf*OSR_nu1(ig,1:L_NSPECTV) + tf*OSR_nu(ig,1:L_NSPECTV) 1047 GSR_nu(ig,1:L_NSPECTV) = ntf*GSR_nu1(ig,1:L_NSPECTV) + tf*GSR_nu(ig,1:L_NSPECTV) 1048 OLR_nu(ig,1:L_NSPECTI) = ntf*OLR_nu1(ig,1:L_NSPECTI) + tf*OLR_nu(ig,1:L_NSPECTI) 1046 OSR_nu(ig,1:L_NSPECTV) = ntf*OSR_nu1(ig,1:L_NSPECTV) + tf*OSR_nu(ig,1:L_NSPECTV) 1047 GSR_nu(ig,1:L_NSPECTV) = ntf*GSR_nu1(ig,1:L_NSPECTV) + tf*GSR_nu(ig,1:L_NSPECTV) 1048 OLR_nu(ig,1:L_NSPECTI) = ntf*OLR_nu1(ig,1:L_NSPECTI) + tf*OLR_nu(ig,1:L_NSPECTI) 1049 1049 if (diagdtau) then 1050 int_dtauv(ig,:,1:L_NSPECTV) = ntf*int_dtauv1(ig,:,1:L_NSPECTV) + tf*int_dtauv(ig,:,1:L_NSPECTV) 1051 int_dtaui(ig,:,1:L_NSPECTI) = ntf*int_dtaui1(ig,:,1:L_NSPECTI) + tf*int_dtaui(ig,:,1:L_NSPECTI) 1050 int_dtauv(ig,:,1:L_NSPECTV) = ntf*int_dtauv1(ig,:,1:L_NSPECTV) + tf*int_dtauv(ig,:,1:L_NSPECTV) 1051 int_dtaui(ig,:,1:L_NSPECTI) = ntf*int_dtaui1(ig,:,1:L_NSPECTI) + tf*int_dtaui(ig,:,1:L_NSPECTI) 1052 1052 endif 1053 enddo 1053 enddo 1054 1054 1055 1055 endif ! end of CLFvarying. … … 1072 1072 ! Net atmospheric radiative heating rate (K.s-1) 1073 1073 dtrad(1:ngrid,1:nlayer)=zdtsw(1:ngrid,1:nlayer)+zdtlw(1:ngrid,1:nlayer) 1074 1075 ! Late initialization of the Ice Spectral Albedo. We needed the visible bands to do that ! 1074 1075 ! Late initialization of the Ice Spectral Albedo. We needed the visible bands to do that ! 1076 1076 if (firstcall .and. albedo_spectral_mode) then 1077 1077 call spectral_albedo_calc(albedo_snow_SPECTV) … … 1079 1079 1080 1080 elseif(newtonian)then 1081 1081 1082 1082 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1083 1083 ! II.b Call Newtonian cooling scheme … … 1089 1089 1090 1090 else 1091 1091 1092 1092 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1093 ! II.c Atmosphere has no radiative effect 1093 ! II.c Atmosphere has no radiative effect 1094 1094 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1095 1095 fluxtop_dn(1:ngrid) = fract(1:ngrid)*mu0(1:ngrid)*Fat1AU/dist_star**2 … … 1100 1100 print*,'------------WARNING---WARNING------------' ! by MT2015. 1101 1101 print*,'You are in corrk=false mode, ' 1102 print*,'and the surface albedo is taken equal to the first visible spectral value' 1103 1102 print*,'and the surface albedo is taken equal to the first visible spectral value' 1103 1104 1104 fluxsurfabs_sw(1:ngrid) = fluxtop_dn(1:ngrid)*(1.-albedo(1:ngrid,1)) 1105 1105 fluxrad_sky(1:ngrid) = fluxsurfabs_sw(1:ngrid) … … 1111 1111 1112 1112 endif ! of if(mod(icount-1,iradia).eq.0) 1113 1113 1114 1114 1115 1115 ! Transformation of the radiative tendencies … … 1119 1119 fluxrad(1:ngrid)=fluxrad_sky(1:ngrid)-zplanck(1:ngrid) 1120 1120 pdt(1:ngrid,1:nlayer)=pdt(1:ngrid,1:nlayer)+dtrad(1:ngrid,1:nlayer) 1121 1121 1122 1122 ! Test of energy conservation 1123 1123 !---------------------------- … … 1152 1152 1153 1153 if (calldifv) then 1154 1154 1155 1155 zflubid(1:ngrid)=fluxrad(1:ngrid)+fluxgrd(1:ngrid) 1156 1156 1157 1157 ! JL12 the following if test is temporarily there to allow us to compare the old vdifc with turbdiff. 1158 1158 if (UseTurbDiff) then 1159 1159 1160 1160 call turbdiff(ngrid,nlayer,nq,rnat, & 1161 1161 ptimestep,capcal, & … … 1168 1168 1169 1169 else 1170 1170 1171 1171 zdh(1:ngrid,1:nlayer)=pdt(1:ngrid,1:nlayer)/zpopsk(1:ngrid,1:nlayer) 1172 1172 1173 1173 call vdifc(ngrid,nlayer,nq,rnat,zpopsk, & 1174 1174 ptimestep,capcal,lwrite, & … … 1199 1199 !! call writediagfi(ngrid,"vdifc_post_zdqsdif"," "," ",2,zdqsdif(1:ngrid,igcm_h2o_vap)) 1200 1200 1201 if (tracer) then 1201 if (tracer) then 1202 1202 pdq(1:ngrid,1:nlayer,1:nq)=pdq(1:ngrid,1:nlayer,1:nq)+ zdqdif(1:ngrid,1:nlayer,1:nq) 1203 1203 dqsurf(1:ngrid,1:nq)=dqsurf(1:ngrid,1:nq) + zdqsdif(1:ngrid,1:nq) … … 1210 1210 !------------------------- 1211 1211 if(enertest)then 1212 1212 1213 1213 dEzdiff(:,:)=cpp*mass(:,:)*zdtdif(:,:) 1214 1214 do ig = 1, ngrid … … 1216 1216 dEzdiff(ig,1)= dEzdiff(ig,1)+ sensibFlux(ig)! subtract flux to the ground 1217 1217 enddo 1218 1218 1219 1219 call planetwide_sumval(dEdiff(:)*cell_area(:)/totarea_planet,dEtot) 1220 1220 dEdiffs(:)=capcal(:)*zdtsdif(:)-zflubid(:)-sensibFlux(:) 1221 1221 call planetwide_sumval(dEdiffs(:)*cell_area(:)/totarea_planet,dEtots) 1222 1222 call planetwide_sumval(sensibFlux(:)*cell_area(:)/totarea_planet,AtmToSurf_TurbFlux) 1223 1223 1224 1224 if (is_master) then 1225 1225 1226 1226 if (UseTurbDiff) then 1227 1227 print*,'In TurbDiff sensible flux (atm=>surf) =',AtmToSurf_TurbFlux,' W m-2' … … 1234 1234 end if 1235 1235 endif ! end of 'is_master' 1236 1236 1237 1237 ! JL12 : note that the black body radiative flux emitted by the surface has been updated by the implicit scheme but not given back elsewhere. 1238 1238 endif ! end of 'enertest' … … 1241 1241 ! Test water conservation. 1242 1242 if(watertest.and.water)then 1243 1243 1244 1244 call planetwide_sumval(massarea(:,:)*zdqdif(:,:,igcm_h2o_vap)*ptimestep/totarea_planet,dWtot_tmp) 1245 1245 call planetwide_sumval(zdqsdif(:,igcm_h2o_vap)*cell_area(:)*ptimestep/totarea_planet,dWtots_tmp) … … 1253 1253 do ig = 1, ngrid 1254 1254 vdifcncons(ig)=vdifcncons(ig) + SUM(mass(ig,:)*zdqdif(ig,:,igcm_h2o_ice)) 1255 enddo 1255 enddo 1256 1256 call planetwide_maxval(vdifcncons(:),nconsMAX) 1257 1257 … … 1281 1281 ! IV. Convection : 1282 1282 !------------------- 1283 1283 1284 1284 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~ 1285 1285 ! IV.a Thermal plume model : 1286 1286 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~ 1287 1287 1288 1288 IF (calltherm) THEN 1289 1289 1290 1290 ! AB: We need to evaporate ice before calling thermcell_main. 1291 1291 IF (water) THEN … … 1295 1295 zqtherm(:,:,:) = pq(:,:,:) + pdq(:,:,:) * ptimestep 1296 1296 ENDIF 1297 1297 1298 1298 CALL thermcell_main(ngrid, nlayer, nq, ptimestep, firstcall, & 1299 1299 pplay, pplev, pphi, zpopsk, & … … 1301 1301 zdutherm, zdvtherm, zdttherm, zdqtherm, & 1302 1302 fm, entr, detr, zw2, fraca) 1303 1303 1304 1304 pdu(1:ngrid,1:nlayer) = pdu(1:ngrid,1:nlayer) + zdutherm(1:ngrid,1:nlayer) 1305 1305 pdv(1:ngrid,1:nlayer) = pdv(1:ngrid,1:nlayer) + zdvtherm(1:ngrid,1:nlayer) 1306 1306 pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer) + zdttherm(1:ngrid,1:nlayer) 1307 1307 1308 1308 IF (tracer) THEN 1309 1309 pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqtherm(1:ngrid,1:nlayer,1:nq) 1310 1310 ENDIF 1311 1311 1312 1312 ENDIF ! end of 'calltherm' 1313 1313 1314 1314 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1315 1315 ! IV.b Dry convective adjustment : … … 1336 1336 zdtadj(1:ngrid,1:nlayer) = zdhadj(1:ngrid,1:nlayer)*zpopsk(1:ngrid,1:nlayer) ! for diagnostic only 1337 1337 1338 if(tracer) then 1339 pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqadj(1:ngrid,1:nlayer,1:nq) 1338 if(tracer) then 1339 pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqadj(1:ngrid,1:nlayer,1:nq) 1340 1340 end if 1341 1341 … … 1356 1356 do ig = 1, ngrid 1357 1357 cadjncons(ig)=cadjncons(ig) + SUM(mass(ig,:)*zdqadj(ig,:,igcm_h2o_ice)) 1358 enddo 1358 enddo 1359 1359 call planetwide_maxval(cadjncons(:),nconsMAX) 1360 1360 … … 1363 1363 print*,'In convadj MAX non-cons factor =',nconsMAX,' kg m-2 s-1' 1364 1364 endif 1365 1365 1366 1366 endif ! end of 'watertest' 1367 1367 1368 1368 endif ! end of 'calladj' 1369 1369 !---------------------------------------------- … … 1394 1394 1395 1395 1396 1396 1397 1397 !----------------------------------------------- 1398 1398 ! V. Carbon dioxide condensation-sublimation : … … 1400 1400 1401 1401 if (co2cond) then 1402 1402 1403 1403 if (.not.tracer) then 1404 1404 print*,'We need a CO2 ice tracer to condense CO2' … … 1435 1435 1436 1436 !--------------------------------------------- 1437 ! VI. Specific parameterizations for tracers 1437 ! VI. Specific parameterizations for tracers 1438 1438 !--------------------------------------------- 1439 1439 1440 1440 if (tracer) then 1441 1441 1442 1442 ! --------------------- 1443 1443 ! VI.1. Water and ice 1444 1444 ! --------------------- 1445 1445 if (water) then 1446 1446 1447 1447 ! Water ice condensation in the atmosphere 1448 1448 if(watercond.and.(RLVTT.gt.1.e-8))then 1449 1449 1450 1450 if ((.not.calltherm).and.moistadjustment) then 1451 1451 dqmoist(1:ngrid,1:nlayer,1:nq)=0. 1452 1452 dtmoist(1:ngrid,1:nlayer)=0. 1453 1453 1454 1454 ! Moist Convective Adjustment. 1455 1455 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ … … 1462 1462 !!!! 1463 1463 call moistadj(ngrid,nlayer,nq,pt,pq,pdq,pplev,pplay,dtmoist,dqmoist,ptimestep,rneb_man) 1464 1464 1465 1465 pdq(1:ngrid,1:nlayer,igcm_h2o_vap) = pdq(1:ngrid,1:nlayer,igcm_h2o_vap) & 1466 1466 + dqmoist(1:ngrid,1:nlayer,igcm_h2o_vap) … … 1468 1468 + dqmoist(1:ngrid,1:nlayer,igcm_h2o_ice) 1469 1469 pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+dtmoist(1:ngrid,1:nlayer) 1470 1470 1471 1471 ! Test energy conservation. 1472 1472 if(enertest)then … … 1475 1475 call planetwide_minval(dtmoist(:,:),dtmoist_min) 1476 1476 madjdEz(:,:)=cpp*mass(:,:)*dtmoist(:,:) 1477 1477 1478 1478 do ig=1,ngrid 1479 1479 madjdE(ig) = cpp*SUM(mass(:,:)*dtmoist(:,:)) 1480 1480 enddo 1481 1481 1482 1482 if (is_master) then 1483 1483 print*,'In moistadj atmospheric energy change =',dEtot,' W m-2' … … 1485 1485 print*,'In moistadj MIN atmospheric energy change =',dtmoist_min*ptimestep,'K/step' 1486 1486 endif 1487 1487 1488 1488 call planetwide_sumval(massarea(:,:)*dqmoist(:,:,igcm_h2o_vap)*ptimestep/totarea_planet+ & 1489 1489 massarea(:,:)*dqmoist(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot) 1490 1490 if (is_master) print*,'In moistadj atmospheric water change =',dWtot,' kg m-2' 1491 1491 1492 1492 endif ! end of 'enertest' 1493 1493 else … … 1497 1497 dqmoist(:,:,:)=0 1498 1498 endif ! end of '(.not.calltherm).and.moistadjustment' 1499 1499 1500 1500 ! Large scale condensation/evaporation. 1501 1501 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ … … 1519 1519 call planetwide_sumval(massarea(:,:)*dqvaplscale(:,:)*ptimestep/totarea_planet+ & 1520 1520 SUM(massarea(:,:)*dqcldlscale(:,:))*ptimestep/totarea_planet,dWtot) 1521 1521 1522 1522 if (is_master) print*,'In largescale atmospheric water change =',dWtot,' kg m-2' 1523 1523 endif ! end of 'enertest' … … 1526 1526 do l = 1, nlayer 1527 1527 do ig=1,ngrid 1528 cloudfrac(ig,l)=MAX(rneb_lsc(ig,l),rneb_man(ig,l)) 1528 cloudfrac(ig,l)=MAX(rneb_lsc(ig,l),rneb_man(ig,l)) 1529 1529 enddo 1530 1530 enddo 1531 1531 1532 1532 endif ! end of 'watercond' 1533 1533 1534 1534 ! Water ice / liquid precipitation. 1535 1535 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1536 zdqrain(1:ngrid,1:nlayer,1:nq) = 0.0 !JL18 need to do that everytimestep if mass redis is on. 1536 zdqrain(1:ngrid,1:nlayer,1:nq) = 0.0 !JL18 need to do that everytimestep if mass redis is on. 1537 1537 1538 1538 if(waterrain)then … … 1549 1549 + zdqrain(1:ngrid,1:nlayer,igcm_h2o_ice) 1550 1550 pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+zdtrain(1:ngrid,1:nlayer) 1551 1551 1552 1552 dqsurf(1:ngrid,igcm_h2o_vap) = dqsurf(1:ngrid,igcm_h2o_vap)+zdqsrain(1:ngrid) 1553 dqsurf(1:ngrid,igcm_h2o_ice) = dqsurf(1:ngrid,igcm_h2o_ice)+zdqssnow(1:ngrid) 1554 1553 dqsurf(1:ngrid,igcm_h2o_ice) = dqsurf(1:ngrid,igcm_h2o_ice)+zdqssnow(1:ngrid) 1554 1555 1555 !! call writediagfi(ngrid,"rain_post_dqsurf"," "," ",2,dqsurf(1:ngrid,igcm_h2o_vap)) 1556 1556 !! call writediagfi(ngrid,"rain_post_qsurf"," "," ",2,qsurf(1:ngrid,igcm_h2o_vap)) 1557 1557 1558 1558 ! Test energy conservation. 1559 1559 if(enertest)then 1560 1560 1561 1561 call planetwide_sumval(cpp*massarea(:,:)*zdtrain(:,:)/totarea_planet,dEtot) 1562 1562 if (is_master) print*,'In rain atmospheric T energy change =',dEtot,' W m-2' … … 1568 1568 dVtot = dVtot + dVtot_tmp 1569 1569 dEtot = dItot + dVtot 1570 1570 1571 1571 if (is_master) then 1572 1572 print*,'In rain dItot =',dItot,' W m-2' … … 1579 1579 massarea(:,:)*zdqrain(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot) 1580 1580 call planetwide_sumval((zdqsrain(:)+zdqssnow(:))*cell_area(:)*ptimestep/totarea_planet,dWtots) 1581 1581 1582 1582 if (is_master) then 1583 1583 print*,'In rain atmospheric water change =',dWtot,' kg m-2' … … 1585 1585 print*,'In rain non-cons factor =',dWtot+dWtots,' kg m-2' 1586 1586 endif 1587 1587 1588 1588 endif ! end of 'enertest' 1589 1589 1590 1590 end if ! enf of 'waterrain' 1591 1591 1592 1592 end if ! end of 'water' 1593 1593 … … 1648 1648 1649 1649 !Generic Condensation 1650 if (generic_condensation) then 1650 if (generic_condensation) then 1651 1651 call condensation_generic(ngrid,nlayer,nq,ptimestep,pplev,pplay, & 1652 1652 pt,pq,pdt,pdq,dt_generic_condensation, & … … 1666 1666 end if 1667 1667 1668 if (.not. water) then 1668 if (.not. water) then 1669 1669 ! Compute GCS (Generic Condensable Specie) cloud fraction. For now we can not have both water cloud fraction and GCS cloud fraction 1670 1670 ! Water is the priority … … 1688 1688 enddo 1689 1689 endif 1690 end do ! do iq=1,nq loop on tracers 1690 end do ! do iq=1,nq loop on tracers 1691 1691 endif ! .not. water 1692 1692 … … 1712 1712 1713 1713 pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+zdtrain_generic(1:ngrid,1:nlayer) 1714 1714 1715 1715 dqsurf(1:ngrid,1:nq) = dqsurf(1:ngrid,1:nq)+zdqsrain_generic(1:ngrid,1:nq) 1716 1716 … … 1719 1719 ! Test energy conservation. 1720 1720 if(enertest)then 1721 1721 1722 1722 call planetwide_sumval(cpp*massarea(:,:)*zdtrain_generic(:,:)/totarea_planet,dEtot) 1723 1723 if (is_master) print*,'In rain_generic atmospheric T energy change =',dEtot,' W m-2' … … 1730 1730 1731 1731 call generic_tracer_index(nq,iq,igcm_generic_vap,igcm_generic_ice,call_ice_vap_generic) 1732 1732 1733 1733 if (call_ice_vap_generic) then ! to call only one time the ice/vap pair of a tracer 1734 1734 … … 1740 1740 dVtot = dVtot + dVtot_tmp 1741 1741 dEtot = dItot + dVtot 1742 1742 1743 1743 if (is_master) then 1744 1744 print*,'In rain_generic dItot =',dItot,' W m-2' … … 1750 1750 massarea(:,:)*dq_rain_generic_cld(:,:,igcm_generic_ice)*ptimestep/totarea_planet,dWtot) 1751 1751 call planetwide_sumval((zdqsrain_generic(:,igcm_generic_ice)+zdqssnow_generic(:,igcm_generic_ice))*cell_area(:)*ptimestep/totarea_planet,dWtots) 1752 1752 1753 1753 if (is_master) then 1754 1754 print*,'In rain_generic atmospheric generic tracer change =',dWtot,' kg m-2' … … 1759 1759 endif 1760 1760 1761 end do ! do iq=1,nq loop on tracers 1762 1761 end do ! do iq=1,nq loop on tracers 1762 1763 1763 endif ! end of 'enertest' 1764 1764 1765 1765 endif !generic_rain 1766 1766 … … 1772 1772 1773 1773 if(watertest)then 1774 1774 1775 1775 iq=igcm_h2o_ice 1776 1776 call planetwide_sumval(massarea(:,:)*pq(:,:,iq)*ptimestep/totarea_planet,dWtot) … … 1781 1781 endif 1782 1782 endif 1783 1783 1784 1784 call callsedim(ngrid,nlayer,ptimestep, & 1785 1785 pplev,zzlev,pt,pdt,pq,pdq, & … … 1834 1834 zdmassmr_col(ig)=SUM(zdmassmr(ig,1:nlayer)) 1835 1835 enddo 1836 1836 1837 1837 call writediagfi(ngrid,"mass_evap","mass gain"," ",3,zdmassmr) 1838 1838 call writediagfi(ngrid,"mass_evap_col","mass gain col"," ",2,zdmassmr_col) … … 1843 1843 pu,pv,pdt,zdtsurf,pdq,pdu,pdv,zdmassmr, & 1844 1844 zdtmr,zdtsurfmr,zdpsrfmr,zdumr,zdvmr,zdqmr,zdqsurfmr) 1845 1845 1846 1846 pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqmr(1:ngrid,1:nlayer,1:nq) 1847 1847 dqsurf(1:ngrid,1:nq) = dqsurf(1:ngrid,1:nq) + zdqsurfmr(1:ngrid,1:nq) … … 1851 1851 pdpsrf(1:ngrid) = pdpsrf(1:ngrid) + zdpsrfmr(1:ngrid) 1852 1852 zdtsurf(1:ngrid) = zdtsurf(1:ngrid) + zdtsurfmr(1:ngrid) 1853 1853 1854 1854 endif 1855 1855 … … 1881 1881 !! flux_g, dt_hdiff, & 1882 1882 !! dt_ekman) 1883 1883 1884 1884 call ocean_slab_noice(icount, ptimestep, knon, knindex, & 1885 1885 zdqssnow, tsea_ice, & … … 1896 1896 call ocean_slab_get_vars(ngrid, tslab, sea_ice, flux_g, & 1897 1897 dt_hdiff, dt_ekman) 1898 1898 1899 1899 do ig=1,ngrid 1900 1900 if (nint(rnat(ig)).eq.1)then … … 1919 1919 1920 1920 if(hydrology)then 1921 1921 1922 1922 call hydrol(ngrid,nq,ptimestep,rnat,tsurf,qsurf,dqsurf,dqs_hyd, & 1923 1923 capcal,albedo,albedo_bareground, & … … 1925 1925 mu0,zdtsurf,zdtsurf_hyd,hice,pctsrf_sic, & 1926 1926 sea_ice) 1927 1927 1928 1928 !! call writediagfi(ngrid,"hydrol_post0_qsurf"," "," ",2,qsurf(1:ngrid,igcm_h2o_vap)) 1929 1929 … … 1931 1931 dqsurf(1:ngrid,1:nq) = dqsurf(1:ngrid,1:nq) + dqs_hyd(1:ngrid,1:nq) 1932 1932 1933 1933 1934 1934 qsurf(1:ngrid,1:nq) = qsurf(1:ngrid,1:nq) + ptimestep*dqsurf(1:ngrid,1:nq) 1935 1935 … … 1960 1960 end if ! of if (hydrology) 1961 1961 1962 ! Add qsurf to qsurf_hist, which is what we save in diagfi.nc. At the same time, we set the water 1962 ! Add qsurf to qsurf_hist, which is what we save in diagfi.nc. At the same time, we set the water 1963 1963 ! content of ocean gridpoints back to zero, in order to avoid rounding errors in vdifc, rain. 1964 1964 qsurf_hist(:,:) = qsurf(:,:) … … 1968 1968 1969 1969 !------------------------------------------------ 1970 ! VII. Surface and sub-surface soil temperature 1970 ! VII. Surface and sub-surface soil temperature 1971 1971 !------------------------------------------------ 1972 1972 … … 1981 1981 tsurf(ig)=tsurf(ig)+ptimestep*zdtsurf(ig) 1982 1982 enddo 1983 1983 1984 1984 else 1985 tsurf(1:ngrid)=tsurf(1:ngrid)+ptimestep*zdtsurf(1:ngrid) 1985 tsurf(1:ngrid)=tsurf(1:ngrid)+ptimestep*zdtsurf(1:ngrid) 1986 1986 endif ! end of 'ok_slab_ocean' 1987 1987 … … 1990 1990 if (callsoil) then 1991 1991 call soil(ngrid,nsoilmx,.false.,lastcall,inertiedat, & 1992 ptimestep,tsurf,tsoil,capcal,fluxgrd) 1992 ptimestep,tsurf,tsoil,capcal,fluxgrd) 1993 1993 endif 1994 1994 1995 1995 1996 1996 if (ok_slab_ocean) then 1997 1997 1998 1998 do ig=1,ngrid 1999 1999 2000 2000 fluxgrdocean(ig)=fluxgrd(ig) 2001 2001 if (nint(rnat(ig)).eq.0) then … … 2013 2013 capcal(ig)=capcalsno 2014 2014 endif 2015 endif 2015 endif 2016 2016 endif 2017 2017 2018 2018 enddo 2019 2019 2020 2020 endif !end of 'ok_slab_ocean' 2021 2021 … … 2023 2023 ! Test energy conservation 2024 2024 if(enertest)then 2025 call planetwide_sumval(cell_area(:)*capcal(:)*zdtsurf(:)/totarea_planet,dEtots) 2025 call planetwide_sumval(cell_area(:)*capcal(:)*zdtsurf(:)/totarea_planet,dEtots) 2026 2026 if (is_master) print*,'Surface energy change =',dEtots,' W m-2' 2027 2027 endif … … 2035 2035 2036 2036 2037 2037 2038 2038 ! Temperature, zonal and meridional winds. 2039 2039 zt(1:ngrid,1:nlayer) = pt(1:ngrid,1:nlayer) + pdt(1:ngrid,1:nlayer)*ptimestep 2040 2040 zu(1:ngrid,1:nlayer) = pu(1:ngrid,1:nlayer) + pdu(1:ngrid,1:nlayer)*ptimestep 2041 2041 zv(1:ngrid,1:nlayer) = pv(1:ngrid,1:nlayer) + pdv(1:ngrid,1:nlayer)*ptimestep 2042 2042 2043 2043 ! Recast thermal plume vertical velocity array for outputs 2044 2044 IF (calltherm) THEN … … 2113 2113 endif 2114 2114 end do 2115 2115 2116 2116 if(ngrid.eq.1)then 2117 2117 DYN=0.0 2118 2118 endif 2119 2119 2120 2120 if (is_master) then 2121 2121 print*,' ISR ASR OLR GND DYN [W m^-2]' … … 2199 2199 2200 2200 h2otot = icesrf + liqsrf + icecol + vapcol 2201 2201 2202 2202 if (is_master) then 2203 2203 print*,' Total water amount [kg m^-2]: ',h2otot … … 2220 2220 ! Calculate RH (Relative Humidity) for diagnostic. 2221 2221 if(water)then 2222 2222 2223 2223 do l = 1, nlayer 2224 2224 do ig=1,ngrid … … 2241 2241 2242 2242 call generic_tracer_index(nq,iq,igcm_generic_vap,igcm_generic_ice,call_ice_vap_generic) 2243 2243 2244 2244 if (call_ice_vap_generic) then ! to call only one time the ice/vap pair of a tracer 2245 2245 2246 2246 do l = 1, nlayer 2247 2247 do ig=1,ngrid … … 2252 2252 2253 2253 end if 2254 2254 2255 2255 end do ! iq=1,nq 2256 2256 … … 2259 2259 2260 2260 if (is_master) print*,'--> Ls =',zls*180./pi 2261 2262 2261 2262 2263 2263 !---------------------------------------------------------------------- 2264 2264 ! Writing NetCDF file "RESTARTFI" at the end of the run … … 2277 2277 2278 2278 #ifndef MESOSCALE 2279 2279 2280 2280 if (ngrid.ne.1) then 2281 2281 write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin 2282 2282 2283 2283 call physdem1("restartfi.nc",nsoilmx,ngrid,nlayer,nq, & 2284 2284 ptimestep,ztime_fin, & … … 2301 2301 ! which can later be used to make the statistic files of the run: 2302 2302 ! if flag "callstats" from callphys.def is .true.) 2303 2303 2304 2304 2305 2305 call wstats(ngrid,"ps","Surface pressure","Pa",2,ps) … … 2311 2311 "Thermal IR radiative flux to space","W.m-2",2, & 2312 2312 fluxtop_lw) 2313 2313 2314 2314 ! call wstats(ngrid,"fluxsurf_sw", & 2315 2315 ! "Solar radiative flux to surface","W.m-2",2, & 2316 ! fluxsurf_sw_tot) 2316 ! fluxsurf_sw_tot) 2317 2317 ! call wstats(ngrid,"fluxtop_sw", & 2318 2318 ! "Solar radiative flux to space","W.m-2",2, & … … 2335 2335 do iq=1,nq 2336 2336 call wstats(ngrid,noms(iq),noms(iq),'kg/kg',3,zq(1,1,iq)) 2337 call wstats(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf', & 2337 call wstats(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf', & 2338 2338 'kg m^-2',2,qsurf(1,iq) ) 2339 call wstats(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col', & 2339 call wstats(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col', & 2340 2340 'kg m^-2',2,qcol(1,iq) ) 2341 2342 ! call wstats(ngrid,trim(noms(iq))//'_reff', & 2343 ! trim(noms(iq))//'_reff', & 2341 2342 ! call wstats(ngrid,trim(noms(iq))//'_reff', & 2343 ! trim(noms(iq))//'_reff', & 2344 2344 ! 'm',3,reffrad(1,1,iq)) 2345 2345 2346 2346 end do 2347 2347 2348 2348 if (water) then 2349 2349 vmr=zq(1:ngrid,1:nlayer,igcm_h2o_vap)*mugaz/mmol(igcm_h2o_vap) 2350 2350 call wstats(ngrid,"vmr_h2ovapor", & 2351 "H2O vapour volume mixing ratio","mol/mol", & 2351 "H2O vapour volume mixing ratio","mol/mol", & 2352 2352 3,vmr) 2353 2353 endif 2354 2354 2355 endif ! end of 'tracer' 2355 endif ! end of 'tracer' 2356 2356 2357 2357 if(watercond.and.CLFvarying)then … … 2381 2381 call mkstats(ierr) 2382 2382 endif 2383 2383 2384 2384 2385 2385 #ifndef MESOSCALE 2386 2386 2387 2387 !----------------------------------------------------------------------------------------------------- 2388 2388 ! OUTPUT in netcdf file "DIAGFI.NC", containing any variable for diagnostic … … 2427 2427 call writediagfi(ngrid,"latentFlux","latent heat flux","w.m^-2",2,zdqsdif(:,igcm_h2o_vap)*RLVTT) 2428 2428 endif 2429 2429 2430 2430 ! Thermal plume model 2431 2431 if (calltherm) then … … 2442 2442 call WRITEDIAGFI(ngrid,"dvgwno","GW non-oro dV","m/s2", 3,d_v_hin) 2443 2443 endif 2444 2444 2445 2445 ! Total energy balance diagnostics 2446 2446 if(callrad.and.(.not.newtonian))then 2447 2447 2448 2448 !call writediagfi(ngrid,"ALB","Surface albedo"," ",2,albedo_equivalent) 2449 2449 !call writediagfi(ngrid,"ALB_1st","First Band Surface albedo"," ",2,albedo(:,1)) … … 2452 2452 call writediagfi(ngrid,"OLR","outgoing longwave rad.","W m-2",2,fluxtop_lw) 2453 2453 call writediagfi(ngrid,"shad","rings"," ", 2, fract) 2454 2454 2455 2455 ! call writediagfi(ngrid,"ASRcs","absorbed stellar rad (cs).","W m-2",2,fluxabs_sw1) 2456 2456 ! call writediagfi(ngrid,"OLRcs","outgoing longwave rad (cs).","W m-2",2,fluxtop_lw1) … … 2465 2465 call writediagfi(ngrid,"GND","heat flux from ground","W m-2",2,fluxgrd) 2466 2466 endif 2467 2467 2468 2468 call writediagfi(ngrid,"DYN","dynamical heat input","W m-2",2,fluxdyn) 2469 2469 2470 2470 endif ! end of 'callrad' 2471 2471 2472 2472 if(enertest) then 2473 2473 2474 2474 if (calldifv) then 2475 2475 2476 2476 call writediagfi(ngrid,"q2","turbulent kinetic energy","J.kg^-1",3,q2) 2477 2477 call writediagfi(ngrid,"sensibFlux","sensible heat flux","w.m^-2",2,sensibFlux) 2478 2478 2479 2479 ! call writediagfi(ngrid,"dEzdiff","turbulent diffusion heating (-sensible flux)","w.m^-2",3,dEzdiff) 2480 2480 ! call writediagfi(ngrid,"dEdiff","integrated turbulent diffusion heating (-sensible flux)","w.m^-2",2,dEdiff) 2481 2481 ! call writediagfi(ngrid,"dEdiffs","In TurbDiff (correc rad+latent heat) surf nrj change","w.m^-2",2,dEdiffs) 2482 2483 endif 2484 2482 2483 endif 2484 2485 2485 if (corrk) then 2486 2486 call writediagfi(ngrid,"dEzradsw","radiative heating","w.m^-2",3,dEzradsw) 2487 2487 call writediagfi(ngrid,"dEzradlw","radiative heating","w.m^-2",3,dEzradlw) 2488 2488 endif 2489 2489 2490 2490 if(watercond) then 2491 2491 2492 call writediagfi(ngrid,"lscaledE","heat from largescale","W m-2",2,lscaledE) 2492 call writediagfi(ngrid,"lscaledE","heat from largescale","W m-2",2,lscaledE) 2493 2493 if ((.not.calltherm).and.moistadjustment) then 2494 2494 call writediagfi(ngrid,"madjdE","heat from moistadj","W m-2",2,madjdE) 2495 2495 endif 2496 2496 call writediagfi(ngrid,"qsatatm","atm qsat"," ",3,qsat) 2497 2498 ! call writediagfi(ngrid,"lscaledEz","heat from largescale","W m-2",3,lscaledEz) 2499 ! call writediagfi(ngrid,"madjdEz","heat from moistadj","W m-2",3,madjdEz) 2497 2498 ! call writediagfi(ngrid,"lscaledEz","heat from largescale","W m-2",3,lscaledEz) 2499 ! call writediagfi(ngrid,"madjdEz","heat from moistadj","W m-2",3,madjdEz) 2500 2500 ! call writediagfi(ngrid,"h2o_max_col","maximum H2O column amount","kg.m^-2",2,H2Omaxcol) 2501 2501 … … 2506 2506 call writediagfi(ngrid,"genericconddE","heat from generic condensation","W m-2",2,genericconddE) 2507 2507 call writediagfi(ngrid,"dt_generic_condensation","heating from generic condensation","K s-1",3,dt_generic_condensation) 2508 2509 endif 2510 2508 2509 endif 2510 2511 2511 endif ! end of 'enertest' 2512 2512 2513 2513 ! Diagnostics of optical thickness 2514 2514 ! Warning this is exp(-tau), I let you postproc with -log to have tau itself - JVO 19 2515 if (diagdtau) then 2515 if (diagdtau) then 2516 2516 do nw=1,L_NSPECTV 2517 2517 write(str2,'(i2.2)') nw … … 2530 2530 call writediagfi(ngrid,"dtrad","radiative heating","K s-1",3,dtrad) 2531 2531 call writediagfi(ngrid,"zdtdyn","Dyn. heating","T s-1",3,zdtdyn) 2532 2532 2533 2533 ! For Debugging. 2534 2534 !call writediagfi(ngrid,'rnat','Terrain type',' ',2,real(rnat)) 2535 2535 !call writediagfi(ngrid,'pphi','Geopotential',' ',3,pphi) 2536 2536 2537 2537 2538 2538 ! Output aerosols. … … 2548 2548 ! Output tracers. 2549 2549 if (tracer) then 2550 2550 2551 2551 do iq=1,nq 2552 2552 call writediagfi(ngrid,noms(iq),noms(iq),'kg/kg',3,zq(1,1,iq)) 2553 call writediagfi(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf', & 2553 call writediagfi(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf', & 2554 2554 'kg m^-2',2,qsurf_hist(1,iq) ) 2555 call writediagfi(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col', & 2555 call writediagfi(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col', & 2556 2556 'kg m^-2',2,qcol(1,iq) ) 2557 ! call writediagfi(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf', & 2558 ! 'kg m^-2',2,qsurf(1,iq) ) 2557 ! call writediagfi(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf', & 2558 ! 'kg m^-2',2,qsurf(1,iq) ) 2559 2559 2560 2560 if(watercond.or.CLFvarying)then … … 2591 2591 2592 2592 enddo ! end of 'nq' loop 2593 2593 2594 2594 endif ! end of 'tracer' 2595 2595 2596 2596 2597 2597 ! Output spectrum. 2598 if(specOLR.and.corrk)then 2598 if(specOLR.and.corrk)then 2599 2599 call writediagspecIR(ngrid,"OLR3D","OLR(lon,lat,band)","W/m^2/cm^-1",3,OLR_nu) 2600 2600 call writediagspecVI(ngrid,"OSR3D","OSR(lon,lat,band)","W/m^2/cm^-1",3,OSR_nu) … … 2628 2628 do iq=1,nq 2629 2629 call generic_tracer_index(nq,iq,igcm_generic_vap,igcm_generic_ice,call_ice_vap_generic) 2630 2630 2631 2631 if (call_ice_vap_generic) then ! to call only one time the ice/vap pair of a tracer 2632 2632 … … 2645 2645 comm_RH(1:ngrid,1:nlayer) = RH_generic(1:ngrid,1:nlayer,iq) 2646 2646 2647 endif 2648 end do ! do iq=1,nq loop on tracers 2647 endif 2648 end do ! do iq=1,nq loop on tracers 2649 2649 2650 2650 else … … 2689 2689 2690 2690 ! XIOS outputs 2691 #ifdef CPP_XIOS 2691 #ifdef CPP_XIOS 2692 2692 ! Send fields to XIOS: (NB these fields must also be defined as 2693 2693 ! <field id="..." /> in context_lmdz_physics.xml to be correctly used) 2694 2694 CALL send_xios_field("ls",zls) 2695 2695 2696 2696 CALL send_xios_field("ps",ps) 2697 2697 CALL send_xios_field("area",cell_area) … … 2701 2701 CALL send_xios_field("v",zv) 2702 2702 CALL send_xios_field("omega",omega) 2703 2703 2704 2704 IF (calltherm) THEN 2705 2705 CALL send_xios_field('w_plm',zw2_bis) … … 2709 2709 ! CALL send_xios_field('fraca',fraca) 2710 2710 ENDIF 2711 2711 2712 2712 IF (water) THEN 2713 2713 CALL send_xios_field('h2o_vap',zq(:,:,igcm_h2o_vap)) … … 2725 2725 CALL send_xios_field("ASR",fluxabs_sw) 2726 2726 2727 if (specOLR .and. corrk) then 2727 if (specOLR .and. corrk) then 2728 2728 call send_xios_field("OLR3D",OLR_nu) 2729 2729 call send_xios_field("IR_Bandwidth",DWNI) … … 2738 2738 endif 2739 2739 #endif 2740 2740 2741 2741 if (check_physics_outputs) then 2742 2742 ! Check the validity of updated fields at the end of the physics step … … 2745 2745 2746 2746 icount=icount+1 2747 2747 2748 2748 end subroutine physiq 2749 2749 2750 2750 end module physiq_mod
Note: See TracChangeset
for help on using the changeset viewer.