Changeset 1750
- Timestamp:
- Apr 25, 2013, 5:27:27 PM (12 years ago)
- Location:
- LMDZ5/branches/testing
- Files:
-
- 4 deleted
- 51 edited
- 8 copied
-
. (modified) (1 prop)
-
DefLists/config.def_IPSLCM5B_AGCM (modified) (2 diffs)
-
DefLists/config.def_LMDZ5_AGCM (modified) (2 diffs)
-
DefLists/gcm.def (modified) (1 diff)
-
arch/arch-X64_ADA.fcm (modified) (1 diff)
-
arch/arch-X64_ADA.path (modified) (1 diff)
-
arch/arch-X64_CURIE.fcm (modified) (1 diff)
-
beta_crf.data (copied) (copied from LMDZ5/trunk/beta_crf.data)
-
create_make_gcm (modified) (4 diffs)
-
libf/dyn3d/guide_mod.F90 (modified) (1 diff)
-
libf/dyn3d/pres2lev.F90 (deleted)
-
libf/dyn3d/pres2lev_mod.F90 (copied) (copied from LMDZ5/trunk/libf/dyn3d/pres2lev_mod.F90)
-
libf/dyn3dmem/conf_gcm.F (modified) (3 diffs)
-
libf/dyn3dmem/guide_loc_mod.F90 (modified) (1 diff)
-
libf/dyn3dmem/pres2lev.F90 (deleted)
-
libf/dyn3dmem/pres2lev_mod.F90 (copied) (copied from LMDZ5/trunk/libf/dyn3dmem/pres2lev_mod.F90)
-
libf/dyn3dpar/conf_gcm.F (modified) (3 diffs)
-
libf/dyn3dpar/guide_p_mod.F90 (modified) (1 diff)
-
libf/dyn3dpar/pres2lev.F90 (deleted)
-
libf/dyn3dpar/pres2lev_mod.F90 (copied) (copied from LMDZ5/trunk/libf/dyn3dpar/pres2lev_mod.F90)
-
libf/phy1d/lmdz1d.F (modified) (8 diffs)
-
libf/phy1d/ttt (deleted)
-
libf/phylmd/aeropt_2bands.F90 (modified) (1 diff)
-
libf/phylmd/aeropt_5wv.F90 (modified) (1 diff)
-
libf/phylmd/calbeta_clim.F90 (copied) (copied from LMDZ5/trunk/libf/phylmd/calbeta_clim.F90)
-
libf/phylmd/calltherm.F90 (modified) (2 diffs)
-
libf/phylmd/clesphys.h (modified) (2 diffs)
-
libf/phylmd/cltrac.F90 (modified) (5 diffs)
-
libf/phylmd/coef_diff_turb_mod.F90 (modified) (1 diff)
-
libf/phylmd/concvl.F (modified) (6 diffs)
-
libf/phylmd/conf_phys_m.F90 (modified) (16 diffs)
-
libf/phylmd/cv30_routines.F (modified) (14 diffs)
-
libf/phylmd/cv3_routines.F (modified) (6 diffs)
-
libf/phylmd/cv3a_uncompress.F (modified) (7 diffs)
-
libf/phylmd/cv3p_mixing.F (modified) (3 diffs)
-
libf/phylmd/cv_driver.F (modified) (15 diffs)
-
libf/phylmd/cva_driver.F (modified) (12 diffs)
-
libf/phylmd/cvltr.F90 (modified) (9 diffs)
-
libf/phylmd/cvltrorig.F90 (copied) (copied from LMDZ5/trunk/libf/phylmd/cvltrorig.F90)
-
libf/phylmd/etat0_netcdf.F90 (modified) (3 diffs)
-
libf/phylmd/evappot.F90 (copied) (copied from LMDZ5/trunk/libf/phylmd/evappot.F90)
-
libf/phylmd/fisrtilp.F90 (modified) (4 diffs)
-
libf/phylmd/ini_histrac.h (modified) (4 diffs)
-
libf/phylmd/init_be.F90 (modified) (35 diffs)
-
libf/phylmd/lsc_scav.F90 (copied) (copied from LMDZ5/trunk/libf/phylmd/lsc_scav.F90)
-
libf/phylmd/newmicro.F (modified) (16 diffs)
-
libf/phylmd/orografi_strato.F (modified) (1 diff)
-
libf/phylmd/phys_local_var_mod.F90 (modified) (3 diffs)
-
libf/phylmd/phys_output_mod.F90 (modified) (10 diffs)
-
libf/phylmd/phys_output_write.h (modified) (4 diffs)
-
libf/phylmd/phys_state_var_mod.F90 (modified) (4 diffs)
-
libf/phylmd/physiq.F (modified) (39 diffs)
-
libf/phylmd/phytrac.F90 (modified) (20 diffs)
-
libf/phylmd/readaerosol_interp.F90 (modified) (1 diff)
-
libf/phylmd/surf_land_bucket_mod.F90 (modified) (3 diffs)
-
libf/phylmd/surface_data.F90 (modified) (1 diff)
-
libf/phylmd/thermcellV0_main.F90 (modified) (2 diffs)
-
libf/phylmd/thermcell_dq.F90 (modified) (6 diffs)
-
libf/phylmd/thermcell_main.F90 (modified) (8 diffs)
-
libf/phylmd/traclmdz_mod.F90 (modified) (7 diffs)
-
libf/phylmd/write_histrac.h (modified) (4 diffs)
-
libf/phylmd/yamada4.F (modified) (13 diffs)
-
tools/install_1d_src.sh (modified) (1 diff, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/testing
- Property svn:mergeinfo changed
/LMDZ5/trunk merged: 1711-1716,1718,1720-1725,1727-1729,1732-1742,1744-1745
- Property svn:mergeinfo changed
-
LMDZ5/branches/testing/DefLists/config.def_IPSLCM5B_AGCM
r1665 r1750 73 73 # Parametres effets directs/indirects des "aerosols" 74 74 ####################################### 75 ### ok cloud droplet number concentration 76 # n par defaut (sans aerosols), y avec aerosols 77 ok_cdnc=y 75 78 ### ok_ade=y/n flag Aerosol direct effect 76 79 ok_ade=y … … 79 82 ### aer_type = Aerosol variation type : actuel / preind / scenario / annuel 80 83 aer_type=preind 81 ### type of coupled aerosol =1 (default) =2 => bc only =3 => pom only =4 => seasalt only =5 => dust only =6 => all aerosol84 ### If aerosol offline : type of coupled aerosol =0 (pas d aerosol) =1 (sulphate only default) =2 => bc only =3 => pom only =4 => seasalt only =5 => dust only =6 => all aerosol 82 85 flag_aerosol=6 83 86 ### bl95_b0 = Parameter in CDNC-maer link (Boucher&Lohmann 1995) -
LMDZ5/branches/testing/DefLists/config.def_LMDZ5_AGCM
r1481 r1750 72 72 # Parametres effets directs/indirects des "aerosols" 73 73 ####################################### 74 ### ok cloud droplet number concentration 75 # n par defaut (sans aerosols), y avec aerosols 76 ok_cdnc=y 74 77 ### ok_ade=y/n flag Aerosol direct effect 75 78 ok_ade=y … … 78 81 ### aer_type = Aerosol variation type : actuel / preind / scenario / annuel 79 82 aer_type=actuel 80 ### type of coupled aerosol =1 (default) =2 => bc only =3 => pom only =4 => seasalt only =5 => dust only =6 => all aerosol83 ### If aerosol offline : type of coupled aerosol =0 (pas d aerosol) =1 (sulphate only default) =2 => bc only =3 => pom only =4 => seasalt only =5 => dust only =6 => all aerosol 81 84 flag_aerosol=6 82 85 ### bl95_b0 = Parameter in CDNC-maer link (Boucher&Lohmann 1995) -
LMDZ5/branches/testing/DefLists/gcm.def
r1481 r1750 5 5 iperiod=5 6 6 ## periode de la dissipation (en pas) 7 idissip=5 7 ## dissip_period=0 8 8 ## choix de l'operateur de dissipation (star ou non star ) 9 9 lstardis=y -
LMDZ5/branches/testing/arch/arch-X64_ADA.fcm
r1707 r1750 3 3 %AR ar 4 4 %MAKE gmake 5 %FPP_FLAGS -P -traditional 6 %FPP_DEF NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM 7 %BASE_FFLAGS - integer-size 32 -real-size 64 -align all8 %PROD_FFLAGS -O 3 -ip5 %FPP_FLAGS -P -traditional -I/smplocal/pub/FFTW/3.3.3/include/ 6 %FPP_DEF NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_FFTW 7 %BASE_FFLAGS -mcmodel=large -integer-size 32 -real-size 64 -align all 8 %PROD_FFLAGS -O2 -ip -fp-model strict -axAVX,SSE4.2 9 9 %DEV_FFLAGS -p -g -O1 -fpe0 -traceback 10 %DEBUG_FFLAGS -p -g -O0 - no-ftz -traceback -ftrapuv -fp-stack-check -check -fpe010 %DEBUG_FFLAGS -p -g -O0 -fpe-all=0 -traceback -ftrapuv -fp-stack-check -check all -debug 11 11 %MPI_FFLAGS 12 12 %OMP_FFLAGS -openmp 13 %%%%BASE_LD -lmkl_intel_lp64 -lmkl_sequential -lmkl_core 14 %BASE_LD -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -lpthread 13 %BASE_LD -shared-intel -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -lpthread -L/smplocal/pub/FFTW/3.3.3/lib -lfftw3 15 14 %MPI_LD 16 15 %OMP_LD -openmp -
LMDZ5/branches/testing/arch/arch-X64_ADA.path
r1707 r1750 1 NETCDF_LIBDIR="${NETCDF_LDFLAGS:--L/smplocal/pub/NetCDF/4.1.3/lib -lnetcdff -lnetcdf }"1 NETCDF_LIBDIR="${NETCDF_LDFLAGS:--L/smplocal/pub/NetCDF/4.1.3/lib -lnetcdff -lnetcdf -L/smplocal/pub/HDF5/1.8.9/seq/lib -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -lz}" 2 2 NETCDF_INCDIR="${NETCDF_FFLAGS:--I/smplocal/pub/HDF5/1.8.9/seq/include -I/smplocal/pub/NetCDF/4.1.3/include}" 3 3 IOIPSL_INCDIR=$LMDGCM/../../lib -
LMDZ5/branches/testing/arch/arch-X64_CURIE.fcm
r1665 r1750 7 7 %BASE_FFLAGS -i4 -r8 -auto -align all -I${MKLROOT}/include 8 8 %PROD_FFLAGS -O3 9 %DEV_FFLAGS -p -g -O2 -traceback -fp-stack-check -ftrapuv9 %DEV_FFLAGS -p -g -O2 -traceback -fp-stack-check 10 10 %DEBUG_FFLAGS -p -g -traceback -fp-stack-check -ftrapuv 11 11 %MPI_FFLAGS -
LMDZ5/branches/testing/create_make_gcm
r1707 r1750 4 4 # 5 5 #set -xv 6 7 rm -f create_make_gcm.log 8 6 9 machine=`hostname` 7 10 os=`uname` … … 122 125 echo 123 126 cd $libf >/dev/null 2>&1 124 for diri in ` ls ` 125 do 127 128 for diri in ` ls ` ; do 129 126 130 if [ -d $diri ] ; then 127 if [ "`ls $diri/*.F `" != "" ] || [ "`ls $diri/*.F90`" != "" ] ; then128 cd $diri >/dev/null 2>&1131 if [ "`ls $diri/*.F $diri/*/*.F`" != "" ] || [ "`ls $diri/*.F90 $diri/*/*.F90`" != "" ] ; then 132 # cd $diri >/dev/null 2>&1 129 133 echo 130 134 listlib="" 131 for i in `ls *.F` 132 do 133 fili=`basename $i .F` 134 test=` ( head $i | grep ' PROGRAM' ) ` 135 if [ "$test" = "" ] ; then 136 listlib=$listlib" "$fili 137 fi 138 done 139 for i in `ls *.F90` 140 do 141 fili=`basename $i .F90` 142 test=` ( head $i | grep ' PROGRAM' ) ` 143 if [ "$test" = "" ] ; then 144 listlib=$listlib" "$fili 145 fi 146 done 147 # 148 echo 149 echo 150 echo "#=======================================================================" 135 # Liste des fichiers .F et .F90 n'etant pas des programmes principaux 136 for fili in `ls $diri/*.F $diri/*/*.F` ; do 137 test=` ( head $fili | grep ' PROGRAM' ) ` 138 if [ "$test" = "" ] ; then listlib=$listlib" "$fili ; fi 139 done 140 for fili in `ls $diri/*.F90 $diri/*/*.F90` ; do 141 test=` ( head $fili | grep 'PROGRAM' ) ` 142 if [ "$test" = "" ] ; then listlib=$listlib" "$fili ; fi 143 done 144 echo 145 echo $listlib >> create_makeg_gcm.log 146 echo 147 echo "#==================================================================" 151 148 echo "# Contenu de la bibliotheque correspondant au Directory "$diri 152 echo "#================================================================== ====="153 echo 154 for fili in $listlib155 do149 echo "#==================================================================" 150 echo 151 for trufile in $listlib ; do 152 fili=`echo $trufile | awk -F/ ' { print $NF } ' | cut -d. -f1` 156 153 echo '$(LIBO)/lib'$diri".a : " '$(LIBO)/lib'$diri".a("$fili".o)" 157 154 echo … … 162 159 echo "# Compilation des membres de la bibliotheque lib"$diri".a" 163 160 echo 164 for fili in $listlib 165 do 166 if [ -f $fili.F90 ] ; then 167 trufile=$fili.F90 168 else 169 trufile=$fili.F 170 fi 161 for trufile in $listlib ; do 162 fili=`echo $trufile | awk -F/ ' { print $NF } ' | cut -d. -f1` 171 163 F90=0 ; egrep -i '^ *use ' $trufile > /dev/null 2>&1 && F90=1 172 164 egrep -i '^ *module ' $trufile > /dev/null 2>&1 && F90=1 173 165 egrep -i '#include*.inc ' $trufile > /dev/null 2>&1 && F90=1 174 str1='$(LIBO)/lib'$diri'.a('$fili'.o) : $(LIBF)/'$diri/$trufile 175 [ "$fili" = "chem.subs" ] && str1=$str1' $(LIBF)/'$diri/chem.mods.F 176 for stri in ` ( sed -n "/\#include/s/\#include//p" $trufile | sed 's/\"//g' ; egrep -i '^ *use ' $trufile | sed -e 's/,/ /' | awk ' { print $2 } ' ) ` 177 do 178 179 166 str1='$(LIBO)/lib'$diri'.a('$fili'.o) : $(LIBF)/'$trufile 167 [ "$fili" = "$diri/chem.subs" ] && str1=$str1' $(LIBF)/'$diri/chem.mods.F 168 169 ########################################################################## 170 # TRAITEMENT DES DEPENDANCES 180 171 # Differents cas de dependance correspondant a des include ou des 181 172 # use module. 182 173 # soit dans le repertoire local soit dans un autre. 183 184 stri=`echo $stri | tr [A-Z] [a-z]` 185 if [ -f $stri ] ; then 174 # Pour dyn3d, il faudrait remplacer la chaine de caractere par $DYN 175 # ou quelque chose du genre. 176 ########################################################################## 177 178 for stri in ` ( sed -e '/^[cC\!]/d' $trufile | sed -n "/\#include/s/\#include//p" | sed 's/\"//g' ; sed -e '/^[cC\!]/d' $trufile | egrep -i '^ *use ' | sed -e 's/,/ /' | awk ' { print $2 } ' ) ` ; do 179 echo $trufile $fili $stri >> create_make_gcm.log 180 strj=`echo $stri | tr [A-Z] [a-z]` 181 str2="" 182 for dirinc in filtrez bibio grid dyn3d $diri $diri/*/ ; do 183 # Recherche dans l'ordre hierarchique inverse car seule la derniere 184 # ligne est conservee 185 if [ -f $dirinc/$stri ] ; then 186 str2='$(LIBF)/'$dirinc/$stri 187 elif [ -f $dirinc/$strj ] ; then 188 str2='$(LIBF)/'$dirinc/$stri 189 elif [ -f $dirinc/$strj.F90 ] || [ -f $dirinc/$strj.F ] ; then 190 strlib=`echo $dirinc | awk -F/ ' { print $1 } '` 191 str2='$(LIBO)/lib'$strlib'.a('$strj'.o)' 192 fi 193 done 194 if [ "$str2" = "" ] ; then 195 echo Warn: Include $diri $trufile $fili $stri pas trouve >> $gcm/create_make_gcm.log 196 elif [ "$str2" = "$str1" ] ; then 197 echo Warn: Include $diri $trufile $fili $stri $str1 trouve 2x >> $gcm/create_make_gcm.log 198 else 186 199 echo $str1 \\ 187 str1='$(LIBF)/'$diri'/'$stri 188 else 189 if [ -f $stri.F ] || [ -f $stri.F90 ] ; then 190 echo $str1 \\ 191 str1='$(LIBO)/lib'$diri'.a('$stri'.o)' 192 else 193 for dirinc in dyn3d grid bibio filtrez 194 do 195 if [ -f ../$dirinc/$stri ] ; then 196 echo $str1 \\ 197 str1='$(LIBF)/'`cd .. ; ls */$stri | head -1` 198 fi 199 if [ -f ../$dirinc/$stri.F90 ] ; then 200 echo $str1 \\ 201 str1='$(LIBO)/lib'$dirinc'.a('$stri'.o)' 202 fi 203 done 204 fi 200 str1=$str2 205 201 fi 206 done 202 done # Fin de la boucle sur les dependances et ecriture de la derniere 207 203 echo $str1 208 204 # Compile in LIBO directory; and before compiling, remove … … 212 208 if [ "$F90" -eq '0' ] ; then 213 209 ## Fixed Form Fortran 77 214 echo ' $(COMPILE) $(LIBF)/'$ diri'/'$trufile' ; \'210 echo ' $(COMPILE) $(LIBF)/'$trufile' ; \' 215 211 else 216 212 ## Fortran 90 217 if [ -f $fili.F90 ] ; then213 if [ `echo $trufile | cut -d. -f2` = F90 ] ; then 218 214 ## Free Form 219 echo ' $(COMPTRU90) $(LIBF)/'$ diri'/'$trufile' ; \'215 echo ' $(COMPTRU90) $(LIBF)/'$trufile' ; \' 220 216 else 221 echo ' $(COMPILE90) $(LIBF)/'$ diri'/'$trufile' ; \'217 echo ' $(COMPILE90) $(LIBF)/'$trufile' ; \' 222 218 fi 223 219 fi -
LMDZ5/branches/testing/libf/dyn3d/guide_mod.F90
r1665 r1750 12 12 USE Write_Field 13 13 use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close 14 use pres2lev_mod 14 15 15 16 IMPLICIT NONE -
LMDZ5/branches/testing/libf/dyn3dmem/conf_gcm.F
r1707 r1750 62 62 LOGICAL fxyhypbb, ysinuss 63 63 INTEGER i 64 64 character(len=*),parameter :: modname="conf_gcm" 65 character (len=80) :: abort_message 66 #ifdef CPP_OMP 67 integer,external :: OMP_GET_NUM_THREADS 68 #endif 65 69 c 66 70 c ------------------------------------------------------------------- … … 91 95 c initialisations: 92 96 c ---------------- 93 adjust=.false.94 call getin('adjust',adjust)95 96 itaumax=097 call getin('itaumax',itaumax);98 if (itaumax<=0) itaumax=HUGE(itaumax)99 97 100 98 !Config Key = lunout … … 109 107 & STATUS='unknown',FORM='formatted') 110 108 ENDIF 109 110 adjust=.false. 111 call getin('adjust',adjust) 112 113 #ifdef CPP_OMP 114 ! adjust=y not implemented in case of OpenMP threads... 115 !$OMP PARALLEL 116 if ((OMP_GET_NUM_THREADS()>1).and.adjust) then 117 write(lunout,*)'conf_gcm: Error, adjust should be set to n' 118 &,' when running with OpenMP threads' 119 abort_message = 'Wrong value for adjust' 120 call abort_gcm(modname,abort_message,1) 121 endif 122 !$OMP END PARALLEL 123 #endif 124 125 itaumax=0 126 call getin('itaumax',itaumax); 127 if (itaumax<=0) itaumax=HUGE(itaumax) 111 128 112 129 !Config Key = prt_level -
LMDZ5/branches/testing/libf/dyn3dmem/guide_loc_mod.F90
r1707 r1750 13 13 use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close 14 14 USE parallel 15 USE pres2lev_mod 15 16 16 17 IMPLICIT NONE -
LMDZ5/branches/testing/libf/dyn3dpar/conf_gcm.F
r1707 r1750 61 61 LOGICAL fxyhypbb, ysinuss 62 62 INTEGER i 63 63 character(len=*),parameter :: modname="conf_gcm" 64 character (len=80) :: abort_message 65 #ifdef CPP_OMP 66 integer,external :: OMP_GET_NUM_THREADS 67 #endif 64 68 c 65 69 c ------------------------------------------------------------------- … … 90 94 c initialisations: 91 95 c ---------------- 92 adjust=.false.93 call getin('adjust',adjust)94 95 itaumax=096 call getin('itaumax',itaumax);97 if (itaumax<=0) itaumax=HUGE(itaumax)98 96 99 97 !Config Key = lunout … … 108 106 & STATUS='unknown',FORM='formatted') 109 107 ENDIF 108 109 adjust=.false. 110 call getin('adjust',adjust) 111 112 #ifdef CPP_OMP 113 ! adjust=y not implemented in case of OpenMP threads... 114 !$OMP PARALLEL 115 if ((OMP_GET_NUM_THREADS()>1).and.adjust) then 116 write(lunout,*)'conf_gcm: Error, adjust should be set to n' 117 &,' when running with OpenMP threads' 118 abort_message = 'Wrong value for adjust' 119 call abort_gcm(modname,abort_message,1) 120 endif 121 !$OMP END PARALLEL 122 #endif 123 124 itaumax=0 125 call getin('itaumax',itaumax); 126 if (itaumax<=0) itaumax=HUGE(itaumax) 110 127 111 128 !Config Key = prt_level -
LMDZ5/branches/testing/libf/dyn3dpar/guide_p_mod.F90
r1665 r1750 11 11 USE getparam 12 12 USE Write_Field_p 13 use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close 13 USE netcdf, ONLY: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close 14 USE pres2lev_mod 14 15 15 16 IMPLICIT NONE -
LMDZ5/branches/testing/libf/phy1d/lmdz1d.F
r1707 r1750 362 362 call infotrac_init 363 363 364 allocate(q(llm,nqtot)) 364 allocate(q(llm,nqtot)) ; q(:,:)=0. 365 365 allocate(dq(llm,nqtot)) 366 366 allocate(dq_dyn(llm,nqtot)) … … 472 472 473 473 call iniphysiq(ngrid,llm,rday,day_ini,timestep, 474 . rlat,rlon,airefi,zcufi,zcvfi,ra,rg,rd,rcpd )474 . rlat,rlon,airefi,zcufi,zcvfi,ra,rg,rd,rcpd,1) 475 475 print*,'apres iniphysiq' 476 476 … … 674 674 675 675 !--------------------------------------------------------------------- 676 ! Listing output for debug prt_level>=1 677 !--------------------------------------------------------------------- 678 if (prt_level>=1) then 679 print *,' avant physiq : -------- day time ',day,time 680 write(*,*) 'firstcall,lastcall,phis', 681 : firstcall,lastcall,phis 682 write(*,'(a10,2a4,4a13)') 'BEFOR1 IT=','it','l', 683 : 'presniv','plev','play','phi' 684 write(*,'(a10,2i4,4f13.2)') ('BEFOR1 IT= ',it,l, 685 : presnivs(l),plev(l),play(l),phi(l),l=1,llm) 686 write(*,'(a11,2a4,a11,6a8)') 'BEFOR2','it','l', 687 : 'presniv','u','v','temp','q1','q2','omega2' 688 write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('BEFOR2 IT= ',it,l, 689 : presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm) 690 endif 691 692 !--------------------------------------------------------------------- 676 693 ! Call physiq : 677 694 !--------------------------------------------------------------------- 678 679 if (prt_level.ge.1) then680 print *,' avant physiq : -------- day time ',day,time681 print *,' temp ',temp682 print *,' u ',u683 print *,' q ',q684 print *,' omega2 ',omega2685 endif686 ! call writefield_phy('u', u,llm)687 695 688 696 call physiq(ngrid,llm, … … 693 701 : du_phys,dv_phys,dt_phys,dq,dpsrf, 694 702 : dudyn,PVteta) 695 ! call writefield_phy('u', u,llm)696 697 703 firstcall=.false. 698 if (prt_level.ge.1) then 699 print*,'APRES PHYS' 700 print *,' temp ',temp 701 print *,' q ',q 702 print *,' dq ',dq 703 print*,'dq_dyn',dq_dyn 704 print *,' dt_phys ',dt_phys 705 print *,' dpsrf ',dpsrf 706 print *,' dudyn ',dudyn 707 print *,' PVteta',PVteta 704 705 !--------------------------------------------------------------------- 706 ! Listing output for debug prt_level>=1 707 !--------------------------------------------------------------------- 708 if (prt_level>=1) then 709 write(*,'(a11,2a4,4a13)') 'AFTER1 IT=','it','l', 710 : 'presniv','plev','play','phi' 711 write(*,'(a11,2i4,4f13.2)') ('AFTER1 it= ',it,l, 712 : presnivs(l),plev(l),play(l),phi(l),l=1,llm) 713 write(*,'(a11,2a4,a11,6a8)') 'AFTER2','it','l', 714 : 'presniv','u','v','temp','q1','q2','omega2' 715 write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('AFTER2 it= ',it,l, 716 : presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm) 717 write(*,'(a11,2a4,a11,5a8)') 'AFTER3','it','l', 718 : 'presniv','du_phys','dv_phys','dt_phys','dq1','dq2' 719 write(*,'(a11,2i4,f11.2,5f8.2)') ('AFTER3 it= ',it,l, 720 : presnivs(l),86400*du_phys(l),86400*dv_phys(l), 721 : 86400*dt_phys(l),86400*dq(l,1),dq(l,2),l=1,llm) 722 write(*,*) 'dpsrf',dpsrf 708 723 endif 709 724 !--------------------------------------------------------------------- … … 711 726 !--------------------------------------------------------------------- 712 727 713 fcoriolis=2.*sin(rpi*xlat/180.)*romega 714 728 fcoriolis=2.*sin(rpi*xlat/180.)*romega 715 729 if (forcing_radconv) then 716 730 fcoriolis=0.0 … … 721 735 722 736 if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice) then 723 fcoriolis=0.0 737 fcoriolis=0.0 ; ug=0. ; vg=0. 724 738 endif 725 739 if(forcing_rico) then … … 727 741 endif 728 742 729 print*, 'fcoriolis ', fcoriolis, rlat(1)743 print*, 'fcoriolis ', fcoriolis, xlat 730 744 731 745 du_age(1:mxcalc)= … … 733 747 dv_age(1:mxcalc)= 734 748 : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc)) 735 ! call writefield_phy('dv_age' ,dv_age,llm) 736 ! call writefield_phy('du_age' ,du_age,llm) 737 ! call writefield_phy('du_phys' ,du_phys,llm) 738 ! call writefield_phy('u_tend' ,u,llm) 739 ! call writefield_phy('u_g' ,ug,llm) 749 740 750 u(1:mxcalc)=u(1:mxcalc) + timestep*( 741 751 : du_phys(1:mxcalc) -
LMDZ5/branches/testing/libf/phylmd/aeropt_2bands.F90
r1664 r1750 11 11 USE aero_mod 12 12 USE phys_local_var_mod, only: absvisaer 13 USE pres2lev_mod 14 13 15 14 16 ! Yves Balkanski le 12 avril 2006 -
LMDZ5/branches/testing/libf/phylmd/aeropt_5wv.F90
r1469 r1750 12 12 USE aero_mod 13 13 USE phys_local_var_mod, only: od550aer,od865aer,ec550aer,od550lt1aer 14 USE pres2lev_mod 15 14 16 15 17 ! -
LMDZ5/branches/testing/libf/phylmd/calltherm.F90
r1669 r1750 234 234 & ,tau_thermals,Ale,Alp,lalim_conv,wght_th & 235 235 & ,zmax0,f0,zw2,fraca) 236 else if (iflag_thermals ==15.or.iflag_thermals==16) then236 else if (iflag_thermals>=15.and.iflag_thermals<=18) then 237 237 238 238 ! print*,'THERM iflag_thermas_ed=',iflag_thermals_ed … … 271 271 ! fait bien ce qu'on croit. 272 272 273 flag_bidouille_stratocu=iflag_thermals<=12.or.iflag_thermals==14.or.iflag_thermals==16 273 flag_bidouille_stratocu=iflag_thermals<=12.or.iflag_thermals==14.or.iflag_thermals==16.or.iflag_thermals==18 274 274 275 275 if (iflag_thermals<=12) then -
LMDZ5/branches/testing/libf/phylmd/clesphys.h
r1664 r1750 19 19 !IM ajout CFMIP2/CMIP5 20 20 REAL co2_ppm_per 21 LOGICAL ok_4xCO2atm 21 22 REAL(kind=8) RCO2_per,RCH4_per,RN2O_per,RCFC11_per,RCFC12_per 22 23 REAL(kind=8) CH4_ppb_per,N2O_ppb_per,CFC11_ppt_per,CFC12_ppt_per … … 81 82 & , RCO2, RCH4, RN2O, RCFC11, RCFC12 & 82 83 & , RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act & 84 & , ok_4xCO2atm & 83 85 & , RCO2_per, RCH4_per, RN2O_per, RCFC11_per, RCFC12_per & 84 86 & , CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt & -
LMDZ5/branches/testing/libf/phylmd/cltrac.F90
r1279 r1750 2 2 ! $Id $ 3 3 ! 4 SUBROUTINE cltrac(dtime,coef,t,tr,flux,paprs,pplay,delp,d_tr) 4 SUBROUTINE cltrac(dtime,coef,t,tr,flux,paprs,pplay,delp, & 5 d_tr,d_tr_dry,flux_tr_dry) !jyg 6 5 7 USE dimphy 6 8 IMPLICIT NONE … … 13 15 ! Arguments: 14 16 !----------- 15 ! dtime....input-R- intervalle du temps (en secondes) 16 ! coef.....input-R- le coefficient d'echange (m**2/s) l>1 17 ! t........input-R- temperature (K) 18 ! tr.......input-R- la q. de traceurs 19 ! flux.....input-R- le flux de traceurs a la surface 20 ! paprs....input-R- pression a inter-couche (Pa) 21 ! pplay....input-R- pression au milieu de couche (Pa) 22 ! delp.....input-R- epaisseur de couche (Pa) 23 ! cdrag....input-R- cdrag pour le flux de surface (non active) 24 ! tr0......input-R- traceurs a la surface ou dans l'ocean (non active) 25 ! d_tr.....output-R- le changement de tr 26 ! flux_tr..output-R- flux de tr 17 ! dtime.......input-R- intervalle du temps (en secondes) 18 ! coef........input-R- le coefficient d'echange (m**2/s) l>1 19 ! t...........input-R- temperature (K) 20 ! tr..........input-R- la q. de traceurs 21 ! flux........input-R- le flux de traceurs a la surface 22 ! paprs.......input-R- pression a inter-couche (Pa) 23 ! pplay.......input-R- pression au milieu de couche (Pa) 24 ! delp........input-R- epaisseur de couche (Pa) 25 ! cdrag.......input-R- cdrag pour le flux de surface (non active) 26 ! tr0.........input-R- traceurs a la surface ou dans l'ocean (non active) 27 ! d_tr........output-R- le changement de tr 28 ! d_tr_dry....output-R- le changement de tr du au depot sec (1st layer) 29 ! flux_tr_dry.output-R- depot sec 30 !!! flux_tr..output-R- flux de tr 27 31 !====================================================================== 28 32 include "YOMCST.h" … … 40 44 ! 41 45 REAL ,DIMENSION(klon,klev),INTENT(OUT) :: d_tr 46 REAL ,DIMENSION(klon),INTENT(OUT) :: d_tr_dry !jyg 47 REAL ,DIMENSION(klon),INTENT(OUT) :: flux_tr_dry !jyg 42 48 ! REAL ,DIMENSION(klon,klev),INTENT(OUT) :: flux_tr 43 49 ! … … 66 72 zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2)) 67 73 zx_alf2(i) = 1.0 - zx_alf1(i) 68 zx_flux(i) = -flux(i)*dtime*RG 74 flux_tr_dry(i) = -flux(i)*dtime !jyg 75 zx_flux(i) = flux_tr_dry(i)*RG !jyg 76 !! zx_flux(i) = -flux(i)*dtime*RG !jyg 69 77 ! Pour le moment le flux est prescrit cdrag et zx_coef(1) vaut 0 70 78 cdrag(i) = 0.0 … … 95 103 zx_dtr(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1)) / & 96 104 zx_buf(i) 105 d_tr_dry(i) = -zx_flux(i)/zx_buf(i) !jyg 97 106 ENDDO 98 107 -
LMDZ5/branches/testing/libf/phylmd/coef_diff_turb_mod.F90
r1665 r1750 158 158 159 159 ! iflag_pbl peut etre utilise comme longuer de melange 160 IF (iflag_pbl.GE.1 1) THEN160 IF (iflag_pbl.GE.18) THEN 161 161 CALL vdif_kcay(knon,dtime,RG,RD,ypaprs,yt, & 162 162 yzlev,yzlay,yu,yv,yteta, & -
LMDZ5/branches/testing/libf/phylmd/concvl.F
r1669 r1750 10 10 . pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr, 11 11 . qcondc,wd,pmflxr,pmflxs, 12 . da,phi,mp,dd_t,dd_q,lalim_conv,wght_th) 12 ! RomP >>> 13 !! . da,phi,mp,dd_t,dd_q,lalim_conv,wght_th) 14 . da,phi,mp,phi2,d1a,dam,sij,clw,elij, ! RomP 15 . dd_t,dd_q,lalim_conv,wght_th, ! RomP 16 . evap, ep, epmlmMm,eplaMm, ! RomP 17 . wdtrainA,wdtrainM) ! RomP 18 ! RomP <<< 13 19 *************************************************************** 14 20 * * … … 91 97 92 98 real da(klon,klev),phi(klon,klev,klev),mp(klon,klev) 99 ! RomP >>> 100 real phi2(klon,klev,klev) 101 real d1a(klon,klev),dam(klon,klev) 102 real sij(klon,klev,klev),clw(klon,klev),elij(klon,klev,klev) 103 REAL wdtrainA(klon,klev),wdtrainM(klon,klev) 104 REAL evap(klon,klev),ep(klon,klev) 105 REAL epmlmMm(klon,klev,klev),eplaMm(klon,klev) 106 ! RomP <<< 93 107 REAL cape(klon),cin(klon),tvp(klon,klev) 94 108 REAL Tconv(klon,klev) … … 248 262 DO i = 1, klon 249 263 cbmf(i) = 0. 250 plcl(i) = 0.264 !! plcl(i) = 0. 251 265 sigd(i) = 0. 252 266 ENDDO … … 256 270 plfc(:) = 0. 257 271 wbeff(:) = 100. 272 plcl(:) = 0. 258 273 259 274 DO k = 1, klev+1 … … 339 354 if (iflag_con.eq.30) then 340 355 341 CALL cv_driver(klon,klev,klev+1,ntra,iflag_con, 356 print *, '-> cv_driver' !jyg 357 CALL cv_driver(klon,klev,klevp1,ntra,iflag_con, 342 358 : t,q,qs,u,v,tra, 343 359 $ em_p,em_ph,iflag, 344 360 $ d_t,d_q,d_u,d_v,d_tra,rain, 345 !! $ pmflxr,cbmf,work1,work2, !jyg 346 $ Vprecip,cbmf,work1,work2, !jyg 361 $ Vprecip,cbmf,work1,work2, !jyg 347 362 $ kbas,ktop, 348 363 $ dtime,Ma,upwd,dnwd,dnwdbis,qcondc,wd,cape, 349 $ da,phi,mp) 364 $ da,phi,mp,phi2,d1a,dam,sij,clw,elij, !RomP 365 $ evap,ep,epmlmMm,eplaMm, !RomP 366 $ wdtrainA,wdtrainM) !RomP 367 print *, 'cv_driver ->' !jyg 350 368 c 351 369 DO i = 1,klon … … 369 387 $ dd_t,dd_q,Plim1,Plim2,asupmax,supmax0, 370 388 $ asupmaxmin,lalim_conv, 371 !AC! 372 $ da,phi) 373 !AC! 389 !AC!+!RomP 390 $ da,phi,mp,phi2,d1a,dam,sij,clw, ! RomP 391 $ elij,evap,ep,wdtrainA,wdtrainM) ! RomP 392 !AC!+!RomP 374 393 endif 375 394 C------------------------------------------------------------------ -
LMDZ5/branches/testing/libf/phylmd/conf_phys_m.F90
r1707 r1750 1 2 1 ! 3 2 ! $Id: conf_phys.F90 1668 2012-10-12 10:47:37Z idelkadi $ … … 18 17 iflag_cldcon, & 19 18 iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, & 20 ok_ade, ok_aie, aerosol_couple, &19 ok_ade, ok_aie, ok_cdnc, aerosol_couple, & 21 20 flag_aerosol, new_aod, & 22 21 bl95_b0, bl95_b1,& … … 60 59 ! ok_instan: sorties instantanees 61 60 ! ok_ade, ok_aie: apply or not aerosol direct and indirect effects 61 ! ok_cdnc, ok cloud droplet number concentration 62 62 ! bl95_b*: parameters in the formula to link CDNC to aerosol mass conc 63 63 ! … … 70 70 logical :: ok_LES 71 71 LOGICAL :: callstats 72 LOGICAL :: ok_ade, ok_aie, aerosol_couple72 LOGICAL :: ok_ade, ok_aie, ok_cdnc, aerosol_couple 73 73 INTEGER :: flag_aerosol 74 74 LOGICAL :: new_aod … … 79 79 80 80 character (len = 6),SAVE :: type_ocean_omp, version_ocean_omp, ocean_omp 81 character (len = 10),SAVE :: type_veget_omp 81 82 CHARACTER(len = 8),SAVE :: aer_type_omp 82 logical,SAVE :: ok_ veget_omp, ok_newmicro_omp83 logical,SAVE :: ok_newmicro_omp 83 84 logical,SAVE :: ok_journe_omp, ok_mensuel_omp, ok_instan_omp, ok_hf_omp 84 85 logical,SAVE :: ok_LES_omp 85 86 LOGICAL,SAVE :: callstats_omp 86 LOGICAL,SAVE :: ok_ade_omp, ok_aie_omp, aerosol_couple_omp87 LOGICAL,SAVE :: ok_ade_omp, ok_aie_omp, ok_cdnc_omp, aerosol_couple_omp 87 88 INTEGER, SAVE :: flag_aerosol_omp 88 89 LOGICAL, SAVE :: new_aod_omp … … 129 130 REAL,SAVE :: CFC11_ppt_omp,RCFC11_omp,CFC11_ppt_per_omp,RCFC11_per_omp 130 131 REAL,SAVE :: CFC12_ppt_omp,RCFC12_omp,CFC12_ppt_per_omp,RCFC12_per_omp 132 LOGICAL,SAVE :: ok_4xCO2atm_omp 131 133 REAL,SAVE :: epmax_omp 132 134 LOGICAL,SAVE :: ok_adj_ema_omp … … 216 218 !Config Help = Type de modele de vegetation utilise 217 219 ! 218 ok_veget_omp = .false.219 call getin('VEGET', ok_veget_omp)220 type_veget_omp ='orchidee' 221 call getin('VEGET', type_veget_omp) 220 222 ! 221 223 !Config Key = OK_journe … … 273 275 274 276 ! 277 !Config Key = ok_cdnc 278 !Config Desc = ok cloud droplet number concentration 279 !Config Def = .false. 280 !Config Help = Used in newmicro.F 281 ! 282 ok_cdnc_omp = .false. 283 call getin('ok_cdnc', ok_cdnc_omp) 284 ! 275 285 !Config Key = aerosol_couple 276 286 !Config Desc = read aerosol in file or calcul by inca … … 280 290 aerosol_couple_omp = .false. 281 291 CALL getin('aerosol_couple',aerosol_couple_omp) 282 283 292 ! 284 293 !Config Key = flag_aerosol … … 523 532 ! 524 533 RCO2_per_omp = co2_ppm_per_omp * 1.0e-06 * 44.011/28.97 534 535 !Config Key = ok_4xCO2atm 536 !Config Desc = Calcul ou non effet radiatif 4xco2 537 !Config Def = .false. 538 !Config Help = 539 540 ok_4xCO2atm_omp = .false. 541 call getin('ok_4xCO2atm',ok_4xCO2atm_omp) 525 542 526 543 !Config Key = RCH4_per … … 1605 1622 RCFC11_act = RCFC11 1606 1623 RCFC12_act = RCFC12 1624 ok_4xCO2atm = ok_4xCO2atm_omp 1607 1625 RCO2_per = RCO2_per_omp 1608 1626 RCH4_per = RCH4_per_omp … … 1666 1684 type_ocean = type_ocean_omp 1667 1685 version_ocean = version_ocean_omp 1668 ok_veget = ok_veget_omp 1686 1687 ok_veget=.true. 1688 type_veget=type_veget_omp 1689 if (type_veget=='n' .or. type_veget=='bucket' .or. type_veget=='betaclim' ) & 1690 & then 1691 ok_veget=.false. 1692 endif 1693 1669 1694 ok_newmicro = ok_newmicro_omp 1670 1695 ok_journe = ok_journe_omp … … 1677 1702 ok_ade = ok_ade_omp 1678 1703 ok_aie = ok_aie_omp 1704 ok_cdnc = ok_cdnc_omp 1679 1705 aerosol_couple = aerosol_couple_omp 1680 1706 flag_aerosol=flag_aerosol_omp … … 1775 1801 END IF 1776 1802 1803 ! ok_cdnc must be set to y if ok_aie is activated 1804 IF (ok_aie .AND. .NOT. ok_cdnc) THEN 1805 CALL abort_gcm('conf_phys', 'ok_cdnc must be set to y if ok_aie is activated',1) 1806 ENDIF 1807 1777 1808 !$OMP MASTER 1778 1809 … … 1781 1812 write(lunout,*)' Type ocean = ', type_ocean 1782 1813 write(lunout,*)' Version ocean = ', version_ocean 1783 write(lunout,*)' Config veget = ', ok_veget 1814 write(lunout,*)' Config veget = ', ok_veget,type_veget 1784 1815 write(lunout,*)' Sortie journaliere = ', ok_journe 1785 1816 write(lunout,*)' Sortie haute frequence = ', ok_hf … … 1800 1831 write(lunout,*)' CFC11_ppt=',CFC11_ppt,' RCFC11_act= ',RCFC11_act 1801 1832 write(lunout,*)' CFC12_ppt=',CFC12_ppt,' RCFC12_act= ',RCFC12_act 1833 write(lunout,*)' ok_4xCO2atm=',ok_4xCO2atm 1802 1834 write(lunout,*)' RCO2_per = ',RCO2_per,' RCH4_per = ', RCH4_per 1803 1835 write(lunout,*)' RN2O_per = ',RN2O_per,' RCFC11_per = ', RCFC11_per -
LMDZ5/branches/testing/libf/phylmd/cv30_routines.F
r1403 r1750 1831 1831 : ,th,tv,lv,cpn,ep,sigp,clw 1832 1832 : ,m,ment,elij,delt,plcl 1833 : ,mp,rp,up,vp,trap,wt,water,evap,b) 1833 : ,mp,rp,up,vp,trap,wt,water,evap,b ! RomP-jyg 1834 : ,wdtrainA,wdtrainM) ! 26/08/10 RomP-jyg 1834 1835 implicit none 1835 1836 … … 1857 1858 real trap(nloc,na,ntra) 1858 1859 real b(nloc,na) 1860 ! 25/08/10 - RomP---- ajout des masses precipitantes ejectees 1861 ! lascendance adiabatique et des flux melanges Pa et Pm. 1862 ! Distinction des wdtrain 1863 ! Pa = wdtrainA Pm = wdtrainM 1864 real wdtrainA(nloc,na), wdtrainM(nloc,na) 1859 1865 1860 1866 c local variables … … 1898 1904 c enddo 1899 1905 c enddo 1900 1906 !! RomP >>> 1907 do i=1,nd 1908 do il=1,ncum 1909 wdtrainA(il,i)=0.0 1910 wdtrainM(il,i)=0.0 1911 enddo 1912 enddo 1913 !! RomP <<< 1901 1914 c 1902 1915 c *** check whether ep(inb)=0, if so, skip precipitating *** … … 1935 1948 if (cvflag_grav) then 1936 1949 wdtrain(il)=grav*ep(il,i)*m(il,i)*clw(il,i) 1950 wdtrainA(il,i) = wdtrain(il)/grav ! Pa 26/08/10 RomP 1937 1951 else 1938 1952 wdtrain(il)=10.0*ep(il,i)*m(il,i)*clw(il,i) 1953 wdtrainA(il,i) = wdtrain(il)/10. ! Pa 26/08/10 RomP 1939 1954 endif 1940 1955 endif … … 1942 1957 1943 1958 if(i.gt.1)then 1959 1944 1960 do 320 j=1,i-1 1945 1961 do il=1,ncum … … 1955 1971 enddo 1956 1972 320 continue 1973 do il=1,ncum 1974 if (cvflag_grav) then 1975 wdtrainM(il,i) = wdtrain(il)/grav-wdtrainA(il,i) ! Pm 26/08/10 RomP 1976 else 1977 wdtrainM(il,i) = wdtrain(il)/10.-wdtrainA(il,i) ! Pm 26/08/10 RomP 1978 endif 1979 enddo 1980 1957 1981 endif 1958 1982 … … 3022 3046 end 3023 3047 3048 !!RomP >>> 3024 3049 SUBROUTINE cv30_tracer(nloc,len,ncum,nd,na, 3025 & ment,sij,da,phi) 3050 & ment,sij,da,phi,phi2,d1a,dam, 3051 & ep,VPrecip,elij,clw,epmlmMm,eplaMm, 3052 & icb,inb) 3026 3053 implicit none 3054 3055 #include "cv30param.h" 3056 3027 3057 c inputs: 3028 3058 integer ncum, nd, na, nloc,len 3029 3059 real ment(nloc,na,na),sij(nloc,na,na) 3060 real clw(nloc,nd),elij(nloc,na,na) 3061 real ep(nloc,na) 3062 integer icb(nloc),inb(nloc) 3063 real VPrecip(nloc,nd+1) 3030 3064 c ouputs: 3031 3065 real da(nloc,na),phi(nloc,na,na) 3066 real phi2(nloc,na,na) 3067 real d1a(nloc,na),dam(nloc,na) 3068 real epmlmMm(nloc,na,na),eplaMm(nloc,na) 3069 ! variables pour tracer dans precip de l'AA et des mel 3032 3070 c local variables: 3033 3071 integer i,j,k 3034 c 3035 da(:,:)=0. 3036 c 3072 real epm(nloc,na,na) 3073 c 3074 ! variables d'Emanuel : du second indice au troisieme 3075 ! ---> tab(i,k,j) -> de l origine k a l arrivee j 3076 ! ment, sij, elij 3077 ! variables personnelles : du troisieme au second indice 3078 ! ---> tab(i,j,k) -> de k a j 3079 ! phi, phi2 3080 ! 3081 ! initialisations 3082 do j=1,na 3083 do i=1,ncum 3084 da(i,j)=0. 3085 d1a(i,j)=0. 3086 dam(i,j)=0. 3087 eplaMm(i,j)=0. 3088 enddo 3089 enddo 3090 do k=1,na 3091 do j=1,na 3092 do i=1,ncum 3093 epm(i,j,k)=0. 3094 epmlmMm(i,j,k)=0. 3095 phi(i,j,k)=0. 3096 phi2(i,j,k)=0. 3097 enddo 3098 enddo 3099 enddo 3100 c 3101 ! fraction deau condensee dans les melanges convertie en precip : epm 3102 ! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz 3103 do j=1,na 3104 do k=1,j-1 3105 do i=1,ncum 3106 if(k.ge.icb(i).and.k.le.inb(i).and. 3107 & j.le.inb(i)) then 3108 !!jyg epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j) 3109 epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/ 3110 & max(elij(i,k,j),1.e-16) 3111 !! 3112 epm(i,j,k)=max(epm(i,j,k),0.0) 3113 endif 3114 end do 3115 end do 3116 end do 3117 ! 3118 do j=1,na 3119 do k=1,na 3120 do i=1,ncum 3121 if(k.ge.icb(i).and.k.le.inb(i)) then 3122 eplaMm(i,j)=eplaMm(i,j) + ep(i,j)*clw(i,j) 3123 & *ment(i,j,k)*(1.-sij(i,j,k)) 3124 endif 3125 end do 3126 end do 3127 end do 3128 ! 3129 do j=1,na 3130 do k=1,j-1 3131 do i=1,ncum 3132 if(k.ge.icb(i).and.k.le.inb(i).and. 3133 & j.le.inb(i)) then 3134 epmlmMm(i,j,k)=epm(i,j,k)*elij(i,k,j)*ment(i,k,j) 3135 endif 3136 end do 3137 end do 3138 end do 3139 3140 ! matrices pour calculer la tendance des concentrations dans cvltr.F90 3037 3141 do j=1,na 3038 3142 do k=1,na 3039 3143 do i=1,ncum 3040 da(i,j)=da(i,j)+(1.-sij(i,k,j))*ment(i,k,j) 3041 phi(i,j,k)=sij(i,k,j)*ment(i,k,j) 3042 c print *,'da',j,k,da(i,j),sij(i,k,j),ment(i,k,j) 3144 da(i,j)=da(i,j)+(1.-sij(i,k,j))*ment(i,k,j) 3145 phi(i,j,k)=sij(i,k,j)*ment(i,k,j) 3146 d1a(i,j)=d1a(i,j)+ment(i,k,j)*ep(i,k) 3147 & *(1.-sij(i,k,j)) 3043 3148 end do 3044 3149 end do 3045 3150 end do 3046 3151 3152 do j=1,na 3153 do k=1,j-1 3154 do i=1,ncum 3155 dam(i,j)=dam(i,j)+ment(i,k,j) 3156 & *epm(i,j,k)*(1.-ep(i,k))*(1.-sij(i,k,j)) 3157 phi2(i,j,k)=phi(i,j,k)*epm(i,j,k) 3158 end do 3159 end do 3160 end do 3161 3047 3162 return 3048 3163 end 3049 3164 !RomP <<< 3050 3165 3051 3166 SUBROUTINE cv30_uncompress(nloc,len,ncum,nd,ntra,idcum 3052 3167 : ,iflag 3053 : ,precip,VPrecip, sig,w03168 : ,precip,VPrecip,evap,ep,sig,w0 3054 3169 : ,ft,fq,fu,fv,ftra 3055 3170 : ,inb 3056 3171 : ,Ma,upwd,dnwd,dnwd0,qcondc,wd,cape 3057 : ,da,phi,mp 3172 : ,da,phi,mp,phi2,d1a,dam,sij 3173 : ,elij,clw,epmlmMm,eplaMm 3174 : ,wdtrainA,wdtrainM 3058 3175 : ,iflag1 3059 : ,precip1,VPrecip1, sig1,w013176 : ,precip1,VPrecip1,evap1,ep1,sig1,w01 3060 3177 : ,ft1,fq1,fu1,fv1,ftra1 3061 3178 : ,inb1 3062 3179 : ,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1 3063 : ,da1,phi1,mp1) 3180 : ,da1,phi1,mp1,phi21,d1a1,dam1,sij1 3181 : ,elij1,clw1,epmlmMm1,eplaMm1 3182 : ,wdtrainA1,wdtrainM1) 3064 3183 implicit none 3065 3184 … … 3072 3191 integer inb(nloc) 3073 3192 real precip(nloc) 3074 real VPrecip(nloc,nd+1) 3193 real VPrecip(nloc,nd+1),evap(nloc,nd) 3194 real ep(nloc,nd) 3075 3195 real sig(nloc,nd), w0(nloc,nd) 3076 3196 real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd) … … 3081 3201 real wd(nloc),cape(nloc) 3082 3202 real da(nloc,nd),phi(nloc,nd,nd),mp(nloc,nd) 3203 !RomP >>> 3204 real phi2(nloc,nd,nd) 3205 real d1a(nloc,nd),dam(nloc,nd) 3206 real wdtrainA(nloc,nd), wdtrainM(nloc,nd) 3207 real sij(nloc,nd,nd) 3208 real elij(nloc,nd,nd),clw(nloc,nd) 3209 real epmlmMm(nloc,nd,nd),eplaMm(nloc,nd) 3210 !RomP <<< 3083 3211 3084 3212 c outputs: … … 3086 3214 integer inb1(len) 3087 3215 real precip1(len) 3088 real VPrecip1(len,nd+1) 3216 real VPrecip1(len,nd+1),evap1(len,nd) !<<< RomP 3217 real ep1(len,nd) !<<< RomP 3089 3218 real sig1(len,nd), w01(len,nd) 3090 3219 real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd) … … 3095 3224 real wd1(nloc),cape1(nloc) 3096 3225 real da1(nloc,nd),phi1(nloc,nd,nd),mp1(nloc,nd) 3226 !RomP >>> 3227 real phi21(len,nd,nd) 3228 real d1a1(len,nd),dam1(len,nd) 3229 real wdtrainA1(len,nd), wdtrainM1(len,nd) 3230 real sij1(len,nd,nd) 3231 real elij1(len,nd,nd),clw1(len,nd) 3232 real epmlmMm1(len,nd,nd),eplaMm1(len,nd) 3233 !RomP <<< 3097 3234 3098 3235 c local variables: … … 3110 3247 do 2010 i=1,ncum 3111 3248 VPrecip1(idcum(i),k)=VPrecip(i,k) 3249 evap1(idcum(i),k)=evap(i,k) !<<< RomP 3112 3250 sig1(idcum(i),k)=sig(i,k) 3113 3251 w01(idcum(i),k)=w0(i,k) … … 3123 3261 da1(idcum(i),k)=da(i,k) 3124 3262 mp1(idcum(i),k)=mp(i,k) 3263 !RomP >>> 3264 ep1(idcum(i),k)=ep(i,k) 3265 d1a1(idcum(i),k)=d1a(i,k) 3266 dam1(idcum(i),k)=dam(i,k) 3267 clw1(idcum(i),k)=clw(i,k) 3268 eplaMm1(idcum(i),k)=eplaMm(i,k) 3269 wdtrainA1(idcum(i),k)=wdtrainA(i,k) 3270 wdtrainM1(idcum(i),k)=wdtrainM(i,k) 3271 !RomP <<< 3125 3272 2010 continue 3126 3273 2020 continue … … 3141 3288 do k=1,nd 3142 3289 do i=1,ncum 3290 sij1(idcum(i),k,j)=sij(i,k,j) 3143 3291 phi1(idcum(i),k,j)=phi(i,k,j) 3292 phi21(idcum(i),k,j)=phi2(i,k,j) 3293 elij1(idcum(i),k,j)=elij(i,k,j) 3294 epmlmMm1(idcum(i),k,j)=epmlmMm(i,k,j) 3144 3295 end do 3145 3296 end do -
LMDZ5/branches/testing/libf/phylmd/cv3_routines.F
r1669 r1750 1950 1950 : ,th,tv,lv,cpn,ep,sigp,clw 1951 1951 : ,m,ment,elij,delt,plcl,coef_clos 1952 o ,mp,rp,up,vp,trap,wt,water,evap,b,sigd) 1952 o ,mp,rp,up,vp,trap,wt,water,evap,b,sigd 1953 o ,wdtrainA,wdtrainM) ! RomP 1953 1954 implicit none 1954 1955 … … 1979 1980 real trap(nloc,na,ntra) 1980 1981 real b(nloc,na), sigd(nloc) 1982 ! 25/08/10 - RomP---- ajout des masses precipitantes ejectees 1983 ! lascendance adiabatique et des flux melanges Pa et Pm. 1984 ! Distinction des wdtrain 1985 ! Pa = wdtrainA Pm = wdtrainM 1986 real wdtrainA(nloc,na), wdtrainM(nloc,na) 1981 1987 1982 1988 c local variables … … 2021 2027 !AC! enddo 2022 2028 !AC! enddo 2029 !! RomP >>> 2030 do i=1,nd 2031 do il=1,ncum 2032 wdtrainA(il,i)=0.0 2033 wdtrainM(il,i)=0.0 2034 enddo 2035 enddo 2036 !! RomP <<< 2023 2037 c 2024 2038 c *** check whether ep(inb)=0, if so, skip precipitating *** … … 2065 2079 if (cvflag_grav) then 2066 2080 wdtrain(il)=grav*ep(il,i)*m(il,i)*clw(il,i) 2081 wdtrainA(il,i) = wdtrain(il)/grav ! Pa RomP 2067 2082 else 2068 2083 wdtrain(il)=10.0*ep(il,i)*m(il,i)*clw(il,i) 2084 wdtrainA(il,i) = wdtrain(il)/10. ! Pa RomP 2069 2085 endif 2070 2086 endif … … 2079 2095 if (cvflag_grav) then 2080 2096 wdtrain(il)=wdtrain(il)+grav*awat*ment(il,j,i) 2097 wdtrainM(il,i) = wdtrain(il)/grav-wdtrainA(il,i) ! Pm RomP 2081 2098 else 2082 2099 wdtrain(il)=wdtrain(il)+10.0*awat*ment(il,j,i) 2100 wdtrainM(il,i) = wdtrain(il)/10.-wdtrainA(il,i) ! Pm RomP 2083 2101 endif 2084 2102 endif … … 3540 3558 end 3541 3559 3542 !AC! 3560 !AC! et !RomP >>> 3543 3561 SUBROUTINE cv3_tracer(nloc,len,ncum,nd,na, 3544 & ment,sij,da,phi) 3562 & ment,sigij,da,phi,phi2,d1a,dam, 3563 & ep,Vprecip,elij,clw,icb,inb) 3545 3564 implicit none 3565 3566 #include "cv3param.h" 3567 3546 3568 c inputs: 3547 3569 integer ncum, nd, na, nloc,len 3548 real ment(nloc,na,na),sij(nloc,na,na) 3570 real ment(nloc,na,na),sigij(nloc,na,na) 3571 real clw(nloc,nd),elij(nloc,na,na) 3572 real ep(nloc,na) 3573 integer icb(nloc),inb(nloc) 3574 real VPrecip(nloc,nd+1) 3549 3575 c ouputs: 3550 3576 real da(nloc,na),phi(nloc,na,na) 3577 real phi2(nloc,na,na) 3578 real d1a(nloc,na),dam(nloc,na) 3579 ! variables pour tracer dans precip de l'AA et des mel 3551 3580 c local variables: 3552 3581 integer i,j,k 3553 c 3554 da(:,:)=0. 3555 c 3582 real epm(nloc,na,na) 3583 c 3584 ! variables d'Emanuel : du second indice au troisieme 3585 ! ---> tab(i,k,j) -> de l origine k a l arrivee j 3586 ! ment, sigij, elij 3587 ! variables personnelles : du troisieme au second indice 3588 ! ---> tab(i,j,k) -> de k a j 3589 ! phi, phi2 3590 ! 3591 ! initialisations 3592 c 3593 da(:,:)=0. 3594 d1a(:,:)=0. 3595 dam(:,:)=0. 3596 epm(:,:,:)=0. 3597 c 3598 ! fraction deau condensee dans les melanges convertie en precip 3599 do j=1,na 3600 do k=1,na 3601 do i=1,ncum 3602 if(k.ge.icb(i).and.k.le.inb(i).and. 3603 & j.ge.k.and.j.le.inb(i)) then 3604 epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j) 3605 epm(i,j,k)=max(epm(i,j,k),0.0) 3606 endif 3607 end do 3608 end do 3609 end do 3610 3611 ! matrices pour calculer la tendance des concentrations dans cvltr.F90 3556 3612 do j=1,na 3557 3613 do k=1,na 3558 3614 do i=1,ncum 3559 da(i,j)=da(i,j)+(1.-sij(i,k,j))*ment(i,k,j) 3560 phi(i,j,k)=sij(i,k,j)*ment(i,k,j) 3615 da(i,j)=da(i,j)+(1.-sigij(i,k,j))*ment(i,k,j) 3616 phi(i,j,k)=sigij(i,k,j)*ment(i,k,j) 3617 d1a(i,j)=d1a(i,j)+ment(i,k,j)*ep(i,k) 3618 & *(1.-sigij(i,k,j)) 3619 if(k.le.j) then 3620 dam(i,j)=dam(i,j)+ment(i,k,j) 3621 & *epm(i,k,j)*(1.-ep(i,k))*(1.-sigij(i,k,j)) 3622 3623 phi2(i,j,k)=phi(i,j,k)*epm(i,j,k) 3624 else 3625 dam(i,j)=0. 3626 phi2(i,j,k)=0. 3627 endif 3561 3628 end do 3562 3629 end do 3563 3630 end do 3631 3564 3632 return 3565 3633 end 3566 !AC! 3634 !AC! et !RomP <<< 3567 3635 3568 3636 SUBROUTINE cv3_uncompress(nloc,len,ncum,nd,ntra,idcum -
LMDZ5/branches/testing/libf/phylmd/cv3a_uncompress.F
r1669 r1750 9 9 : ,Plim1,Plim2,asupmax,supmax0 10 10 : ,asupmaxmin 11 !AC! 12 : ,da,phi 13 !AC! 11 ! 12 : ,da,phi !AC! 13 : ,mp,phi2,d1a,dam,sigij !RomP 14 : ,wdtrainA,wdtrainM,elij,clw !RomP 15 : ,evap,ep !RomP 16 ! 14 17 o ,iflag1,kbas1,ktop1 15 18 : ,precip1,cbmf1,plcl1,plfc1,wbeff1,sig1,w01,ptop21 … … 21 24 : ,Plim11,Plim21,asupmax1,supmax01 22 25 : ,asupmaxmin1 23 !AC! 24 : ,da1,phi1 ) 25 !AC! 26 ! 27 o ,da1,phi1 !AC! 28 o ,mp1,phi21,d1a1,dam1,sigij1 !RomP 29 o ,wdtrainA1,wdtrainM1,elij1,clw1 !RomP 30 o ,evap1,ep1) !RomP 31 ! 26 32 *************************************************************** 27 33 * * … … 56 62 real asupmax(nloc,nd),supmax0(nloc) 57 63 real asupmaxmin(nloc) 58 !AC! 59 real da(nloc,nd),phi(nloc,nd,nd) 60 !AC! 64 ! 65 real da(nloc,nd),phi(nloc,nd,nd) !AC! 66 real mp(nloc,nd) !RomP 67 real phi2(nloc,nd,nd) !RomP 68 real d1a(nloc,nd),dam(nloc,nd) !RomP 69 real wdtrainA(nloc,nd), wdtrainM(nloc,nd) !RomP 70 real sigij(nloc,nd,nd) !RomP 71 real elij(nloc,nd,nd),clw(nloc,nd) !RomP 72 real evap(nloc,nd),ep(nloc,nd) !RomP 73 ! 61 74 c outputs: 62 75 integer iflag1(len),kbas1(len),ktop1(len) … … 76 89 real asupmax1(len,nd),supmax01(len) 77 90 real asupmaxmin1(len) 78 !AC! 79 real da1(nloc,nd),phi1(nloc,nd,nd) 80 !AC! 91 ! 92 real da1(nloc,nd),phi1(nloc,nd,nd) !AC! 93 real mp1(nloc,nd) !RomP 94 real phi21(nloc,nd,nd) !RomP 95 real d1a1(nloc,nd),dam1(nloc,nd) !RomP 96 real wdtrainA1(len,nd), wdtrainM1(len,nd) !RomP 97 real sigij1(len,nd,nd) !RomP 98 real elij1(len,nd,nd),clw1(len,nd) !RomP 99 real evap1(len,nd),ep1(len,nd) !RomP 100 ! 81 101 c 82 102 c local variables: … … 122 142 fqd1(idcum(i),k)=fqd(i,k) 123 143 asupmax1(idcum(i),k)=asupmax(i,k) 124 !AC! 125 da1(idcum(i),k)=da(i,k) 126 !AC! 144 ! 145 da1(idcum(i),k)=da(i,k) !AC! 146 mp1(idcum(i),k) = mp(i,k) !RomP 147 d1a1(idcum(i),k) = d1a(i,k) !RomP 148 dam1(idcum(i),k) = dam(i,k) !RomP 149 wdtrainA1(idcum(i),k)= wdtrainA(i,k) !RomP 150 wdtrainM1(idcum(i),k)= wdtrainM(i,k) !RomP 151 clw1(idcum(i),k) = clw(i,k) !RomP 152 evap1(idcum(i),k) = evap(i,k) !RomP 153 ep1(idcum(i),k) = ep(i,k) !RomP 154 ! 127 155 2010 continue 128 156 2020 continue … … 143 171 144 172 !AC! 145 do j=1,nd146 do k =1,nd173 do k2=1,nd 174 do k1=1,nd 147 175 do i=1,ncum 148 phi1(idcum(i),k,j)=phi(i,k,j) 176 phi1(idcum(i),k1,k2)=phi(i,k1,k2) !AC! 177 phi21(idcum(i),k1,k2)= phi2(idcum(i),k1,k2) !RomP 178 sigij1(idcum(i),k1,k2) = sigij(idcum(i),k1,k2) !RomP 179 elij1(idcum(i),k1,k2)= elij(idcum(i),k1,k2) !RomP 149 180 end do 150 181 end do … … 157 188 c do 2200 i=1,ncum 158 189 c ment1(idcum(i),k1,k2) = ment(i,k1,k2) 159 c si j1(idcum(i),k1,k2) = sij(i,k1,k2)190 c sigij1(idcum(i),k1,k2) = sigij(i,k1,k2) 160 191 c2200 enddo 161 192 c2210 enddo -
LMDZ5/branches/testing/libf/phylmd/cv3p_mixing.F
r1669 r1750 3 3 : ,unk,vnk,hp,tv,tvp,ep,clw,sig 4 4 : ,ment,qent,hent,uent,vent,nent 5 : ,si j,elij,supmax,ments,qents,traent)5 : ,sigij,elij,supmax,ments,qents,traent) 6 6 *************************************************************** 7 7 * * … … 36 36 real ment(nloc,na,na), qent(nloc,na,na) 37 37 real uent(nloc,na,na), vent(nloc,na,na) 38 real si j(nloc,na,na), elij(nloc,na,na)38 real sigij(nloc,na,na), elij(nloc,na,na) 39 39 real supmax(nloc,na) ! Highest mixing fraction of mixed updraughts 40 40 ! with the sign of (h-hp) 41 41 real traent(nloc,nd,nd,ntra) 42 42 real ments(nloc,nd,nd), qents(nloc,nd,nd) 43 real sigij(nloc,nd,nd)44 43 real hent(nloc,nd,nd) 45 44 integer nent(nloc,nd) … … 57 56 real Sbef(nloc), Sup(nloc), Smin(nloc) 58 57 real asij(nloc), smax(nloc), scrit(nloc) 58 real sij(nloc,nd,nd) 59 59 real csum(nloc,nd) 60 60 real awat -
LMDZ5/branches/testing/libf/phylmd/cv_driver.F
r965 r1750 9 9 & icb1,inb1, 10 10 & delt,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1, 11 & da1,phi1,mp1) 11 & da1,phi1,mp1,phi21,d1a1,dam1,sij1,clw1,elij1, 12 & evap1,ep1,epmlmMm1,eplaMm1, 13 & wdtrainA1,wdtrainM1) 12 14 C 13 15 USE dimphy … … 67 69 cym#include "dimensions.h" 68 70 cym#include "dimphy.h" 69 71 c 72 c Input 70 73 integer len 71 74 integer nd … … 74 77 integer iflag_con 75 78 integer ntra 79 real delt 76 80 real t1(len,nd) 77 81 real q1(len,nd) … … 79 83 real u1(len,nd) 80 84 real v1(len,nd) 85 real tra1(len,nd,ntra) 81 86 real p1(len,nd) 82 87 real ph1(len,ndp1) 88 c 89 c Output 83 90 integer iflag1(len) 84 91 real ft1(len,nd) … … 86 93 real fu1(len,nd) 87 94 real fv1(len,nd) 95 real ftra1(len,nd,ntra) 88 96 real precip1(len) 89 97 real cbmf1(len) 90 real VPrecip1(len,nd+1) 98 real sig1(klon,klev) 99 real w01(klon,klev) 100 real VPrecip1(len,nd+1) 101 real evap1(len,nd) !RomP 102 real ep1(len,nd) !RomP 91 103 real Ma1(len,nd) 92 104 real upwd1(len,nd) … … 98 110 real cape1(len) 99 111 112 ! RomP >>> 113 real wdtrainA1(len,nd), wdtrainM1(len,nd) 114 real sij1(len,nd,nd),elij1(len,nd,nd) 100 115 real da1(len,nd),phi1(len,nd,nd),mp1(len,nd) 101 real da(len,nd),phi(len,nd,nd),mp(len,nd) 102 real tra1(len,nd,ntra) 103 real ftra1(len,nd,ntra) 104 105 real delt 116 117 real phi21(len,nd,nd) 118 real d1a1(len,nd), dam1(len,nd) 119 real epmlmMm1(len,nd,nd),eplaMm1(len,nd) 120 ! RomP <<< 121 106 122 107 123 !------------------------------------------------------------------- … … 243 259 real tvp1(klon,klev) 244 260 real clw1(klon,klev) 245 real sig1(klon,klev)246 real w01(klon,klev)247 261 real th1(klon,klev) 248 262 c … … 277 291 real ments(nloc,klev,klev), qents(nloc,klev,klev) 278 292 real sij(nloc,klev,klev), elij(nloc,klev,klev) 293 ! RomP >>> 294 real da(nloc,klev),phi(nloc,klev,klev),mp(nloc,klev) 295 real epmlmMm(nloc,klev,klev),eplaMm(nloc,klev) 296 real phi2(nloc,klev,klev) 297 real d1a(nloc,klev), dam(nloc,klev) 298 real wdtrainA(nloc,klev),wdtrainM(nloc,klev) 299 real sigd(nloc) 300 ! RomP <<< 279 301 real qp(nloc,klev), up(nloc,klev), vp(nloc,klev) 280 302 real wt(nloc,klev), water(nloc,klev), evap(nloc,klev) … … 295 317 ! --- SET CONSTANTS AND PARAMETERS 296 318 !------------------------------------------------------------------- 297 319 print *, '-> cv_driver' !jyg 298 320 c -- set simulation flags: 299 321 c (common cvflag) … … 325 347 !--------------------------------------------------------------------- 326 348 327 do 20 k=1,nd 328 do 10 i=1,len 329 ft1(i,k)=0.0 330 fq1(i,k)=0.0 331 fu1(i,k)=0.0 332 fv1(i,k)=0.0 333 tvp1(i,k)=0.0 334 tp1(i,k)=0.0 335 clw1(i,k)=0.0 349 ft1(:,:)=0.0 350 fq1(:,:)=0.0 351 fu1(:,:)=0.0 352 fv1(:,:)=0.0 353 tvp1(:,:)=0.0 354 tp1(:,:)=0.0 355 clw1(:,:)=0.0 336 356 cym 337 clw(i,k)=0.0 338 gz1(i,k) = 0. 339 VPrecip1(i,k) = 0. 340 Ma1(i,k)=0.0 341 upwd1(i,k)=0.0 342 dnwd1(i,k)=0.0 343 dnwd01(i,k)=0.0 344 qcondc1(i,k)=0.0 345 10 continue 346 20 continue 347 348 do 30 j=1,ntra 349 do 31 k=1,nd 350 do 32 i=1,len 351 ftra1(i,k,j)=0.0 352 32 continue 353 31 continue 354 30 continue 355 356 do 60 i=1,len 357 precip1(i)=0.0 358 iflag1(i)=0 359 wd1(i)=0.0 360 cape1(i)=0.0 361 VPrecip1(i,nd+1)=0.0 362 60 continue 357 clw(:,:)=0.0 358 gz1(:,:) = 0. 359 VPrecip1(:,:) = 0. 360 Ma1(:,:)=0.0 361 upwd1(:,:)=0.0 362 dnwd1(:,:)=0.0 363 dnwd01(:,:)=0.0 364 qcondc1(:,:)=0.0 365 366 ftra1(:,:,:)=0.0 367 368 elij1(:,:,:) = 0.0 369 sij1(:,:,:) = 0.0 370 371 precip1(:)=0.0 372 iflag1(:)=0 373 wd1(:)=0.0 374 cape1(:)=0.0 363 375 364 376 if (iflag_con.eq.30) then … … 441 453 400 continue 442 454 443 c print*,'klon, ncum = ',len,ncum455 print*,'cv_driver : klon, ncum = ',len,ncum 444 456 445 457 IF (ncum.gt.0) THEN … … 541 553 542 554 if (iflag_con.eq.30) then 543 CALL cv30_unsat(nloc,ncum,nd,nd,ntra,icb,inb ! na->nd 555 !RomP >>> 556 CALL cv30_unsat(nloc,ncum,nd,nd,ntra,icb,inb ! na->nd 544 557 : ,t,q,qs,gz,u,v,tra,p,ph 545 558 : ,th,tv,lv,cpn,ep,sigp,clw 546 559 : ,m,ment,elij,delt,plcl 547 o ,mp,qp,up,vp,trap,wt,water,evap,b) 560 : ,mp,qp,up,vp,trap,wt,water,evap,b 561 o ,wdtrainA,wdtrainM) 562 !RomP <<< 548 563 endif 549 564 … … 588 603 589 604 if (iflag_con.eq.30) then 605 !RomP >>> 590 606 CALL cv30_tracer(nloc,len,ncum,nd,nd, 591 : ment,sij,da,phi) 607 : ment,sij,da,phi,phi2,d1a,dam, 608 : ep,VPrecip,elij,clw,epmlmMm,eplaMm, 609 : icb,inb) 610 !RomP <<< 592 611 endif 593 612 … … 603 622 CALL cv30_uncompress(nloc,len,ncum,nd,ntra,idcum 604 623 : ,iflag 605 : ,precip,VPrecip, sig,w0624 : ,precip,VPrecip,evap,ep,sig,w0 !RomP 606 625 : ,ft,fq,fu,fv,ftra 607 : ,inb 626 : ,inb 608 627 : ,Ma,upwd,dnwd,dnwd0,qcondc,wd,cape 609 : ,da,phi,mp 628 : ,da,phi,mp,phi2,d1a,dam,sij !RomP 629 : ,elij,clw,epmlmMm,eplaMm !RomP 630 : ,wdtrainA,wdtrainM !RomP 610 631 o ,iflag1 611 o ,precip1,VPrecip1, sig1,w01632 o ,precip1,VPrecip1,evap1,ep1,sig1,w01 !RomP 612 633 o ,ft1,fq1,fu1,fv1,ftra1 613 634 o ,inb1 614 635 o ,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1 615 o ,da1,phi1,mp1) 636 o ,da1,phi1,mp1,phi21,d1a1,dam1,sij1 !RomP 637 o ,elij1,clw1,epmlmMm1,eplaMm1 !RomP 638 o ,wdtrainA1,wdtrainM1) !RomP 616 639 endif 617 640 … … 632 655 9999 continue 633 656 657 print *, 'fin cv_driver ->' !jyg 634 658 return 635 659 end -
LMDZ5/branches/testing/libf/phylmd/cva_driver.F
r1669 r1750 21 21 & Plim11,Plim21,asupmax1,supmax01,asupmaxmin1 22 22 & ,lalim_conv, 23 !AC! 24 & da1,phi1)25 !AC! 23 & da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, ! RomP 24 & elij1,evap1,ep1, ! RomP 25 & wdtrainA1,wdtrainM1) ! RomP 26 26 *************************************************************** 27 27 * * … … 175 175 c 176 176 !AC! 177 real da1(len,nd),phi1(len,nd,nd)178 real da(len,nd),phi(len,nd,nd)177 !! real da1(len,nd),phi1(len,nd,nd) 178 !! real da(len,nd),phi(len,nd,nd) 179 179 !AC! 180 180 real ftd1(len,nd) … … 186 186 real asupmaxmin1(len) 187 187 integer lalim_conv(len) 188 ! RomP >>> 189 real wdtrainA1(len,nd), wdtrainM1(len,nd) 190 real wdtrainA(nloc,klev),wdtrainM(nloc,klev) 191 real da1(len,nd),phi1(len,nd,nd),mp1(len,nd) 192 real da(len,nd),phi(len,nd,nd) 193 real evap1(len,nd),ep1(len,nd) 194 real sigij1(len,nd,nd),elij1(len,nd,nd) 195 real phi2(len,nd,nd) 196 real d1a(len,nd), dam(len,nd) 197 real phi21(len,nd,nd) 198 real d1a1(len,nd), dam1(len,nd) 199 ! RomP <<< 188 200 !------------------------------------------------------------------- 189 201 ! --- ARGUMENTS … … 397 409 real cin(nloc) 398 410 real m(nloc,klev) 399 real ment(nloc,klev,klev), si j(nloc,klev,klev)411 real ment(nloc,klev,klev), sigij(nloc,klev,klev) 400 412 real qent(nloc,klev,klev) 401 413 real hent(nloc,klev,klev) … … 505 517 call zilch(cbmf1 ,nword1) 506 518 call zilch(ptop21 ,nword1) 507 sigd1 =0.519 sigd1(:)=0. 508 520 call zilch(Ma1 ,nword2) 509 521 call zilch(mip1 ,nword2) … … 771 783 : ,unk,vnk,hp,tv,tvp,ep,clw,sig 772 784 : ,ment,qent,hent,uent,vent,nent 773 : ,si j,elij,supmax,ments,qents,traent)785 : ,sigij,elij,supmax,ments,qents,traent) 774 786 ! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd) 775 787 … … 828 840 : ,ph,t,q,qs,u,v,tra,h,lv,qnk 829 841 : ,unk,vnk,hp,tv,tvp,ep,clw,m,sig 830 o ,ment,qent,uent,vent,nent,si j,elij,ments,qents,traent)842 o ,ment,qent,uent,vent,nent,sigij,elij,ments,qents,traent) 831 843 CALL zilch(hent,nloc*klev*klev) 832 844 ELSE … … 842 854 : ,ph,t,q,qs,u,v,h,lv,qnk 843 855 : ,hp,tv,tvp,ep,clw,cbmf 844 o ,m,ment,qent,uent,vent,nent,si j,elij)856 o ,m,ment,qent,uent,vent,nent,sigij,elij) 845 857 endif 846 858 c … … 865 877 : ,ep,sigp,clw 866 878 : ,m,ment,elij,delt,plcl,coef_clos 867 o ,mp,qp,up,vp,trap,wt,water,evap,b,sigd) 879 o ,mp,qp,up,vp,trap,wt,water,evap,b,sigd 880 o ,wdtrainA,wdtrainM) ! RomP 868 881 endif 869 882 … … 925 938 926 939 if (iflag_con.eq.3) then 940 !RomP >>> 927 941 CALL cv3_tracer(nloc,len,ncum,nd,nd, 928 : ment,sij,da,phi) 942 : ment,sigij,da,phi,phi2,d1a,dam, 943 : ep,Vprecip,elij,clw,icb,inb) 944 !RomP <<< 929 945 endif 930 946 … … 947 963 : ,Plim1,Plim2,asupmax,supmax0 948 964 : ,asupmaxmin 949 !AC! 950 : , da,phi951 !AC! 965 : ,da,phi,mp,phi2,d1a,dam,sigij ! RomP 966 : ,wdtrainA,wdtrainM,elij,clw ! RomP 967 : ,evap,ep ! RomP 952 968 o ,iflag1,kbas1,ktop1 953 969 o ,precip1,cbmf1,plcl1,plfc1,wbeff1,sig1,w01,ptop21 … … 959 975 o ,Plim11,Plim21,asupmax1,supmax01 960 976 o ,asupmaxmin1 961 !AC! 962 o , da1,phi1)963 !AC! 977 o ,da1,phi1,mp1,phi21,d1a1,dam1,sigij1 ! RomP 978 o ,wdtrainA1,wdtrainM1,elij1,clw1 ! RomP 979 o ,evap1,ep1) ! RomP 964 980 endif 965 981 -
LMDZ5/branches/testing/libf/phylmd/cvltr.F90
r1279 r1750 2 2 ! $Id $ 3 3 ! 4 SUBROUTINE cvltr(pdtime,da, phi, mp,paprs,pplay,x,upd,dnd,dx) 4 SUBROUTINE cvltr(pdtime, da, phi,phi2,d1a,dam, mpIN,epIN, & 5 sigd,sij,clw,elij,epmlmMm,eplaMm, & 6 pmflxrIN,pmflxsIN,ev,te,wdtrainA,wdtrainM, & 7 paprs,it,tr,upd,dnd,inb,icb, & 8 dtrcv,trsptd,dtrSscav,dtrsat,dtrUscav,qDi,qPr, & 9 qPa,qMel,qTrdi,dtrcvMA,Mint, & 10 zmfd1a,zmfphi2,zmfdam) 11 USE IOIPSL 5 12 USE dimphy 13 USE infotrac, ONLY : nbtr,tname 6 14 IMPLICIT NONE 7 15 !===================================================================== 8 16 ! Objet : convection des traceurs / KE 9 17 ! Auteurs: M-A Filiberti and J-Y Grandpeix 18 ! modifiee par R Pilon : lessivage des traceurs / KE 10 19 !===================================================================== 11 20 12 21 include "YOMCST.h" 13 include "YOECUMF.h" 22 include "YOECUMF.h" 23 include "conema3.h" 14 24 15 25 ! Entree … … 17 27 REAL,DIMENSION(klon,klev),INTENT(IN) :: da 18 28 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi 19 REAL,DIMENSION(klon,klev),INTENT(IN) :: mp 20 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression aux 1/2 couches (bas en haut) 21 REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le milieu de chaque couche 22 REAL,DIMENSION(klon,klev),INTENT(IN) :: x ! q de traceur (bas en haut) 29 ! RomP 30 REAL,DIMENSION(klon,klev),INTENT(IN) :: d1a,dam ! matrices pour simplifier 31 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2 ! l'ecriture des tendances 32 ! 33 REAL,DIMENSION(klon,klev),INTENT(IN) :: mpIN 34 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression aux 1/2 couches (bas en haut) 35 ! REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression aux 1/2 couches (bas en haut) 36 REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr ! q de traceur (bas en haut) 37 INTEGER,INTENT(IN) :: it 23 38 REAL,DIMENSION(klon,klev),INTENT(IN) :: upd ! saturated updraft mass flux 24 39 REAL,DIMENSION(klon,klev),INTENT(IN) :: dnd ! saturated downdraft mass flux 25 40 ! 41 REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainA ! masses precipitantes de l'asc adiab 42 REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainM ! masses precipitantes des melanges 43 REAL,DIMENSION(klon,klev),INTENT(IN) :: pmflxrIN ! vprecip: eau 44 REAL,DIMENSION(klon,klev),INTENT(IN) :: pmflxsIN ! vprecip: neige 45 REAL,DIMENSION(klon,klev),INTENT(IN) :: ev ! evaporation cv30_routine 46 REAL,DIMENSION(klon,klev),INTENT(IN) :: epIN 47 REAL,DIMENSION(klon,klev),INTENT(IN) :: te 48 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij ! fraction dair de lenv 49 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij ! contenu en eau condensée spécifique/conc deau condensée massique 50 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm ! eau condensee precipitee dans mel masse dair sat 51 REAL,DIMENSION(klon,klev),INTENT(IN) :: eplaMm ! eau condensee precipitee dans aa masse dair sat 52 53 REAL,DIMENSION(klon,klev),INTENT(IN) :: clw ! contenu en eau condensée dans lasc adiab 54 REAL,DIMENSION(klon),INTENT(IN) :: sigd 55 INTEGER,DIMENSION(klon),INTENT(IN) :: icb,inb 26 56 ! Sortie 27 REAL,DIMENSION(klon,klev),INTENT(OUT) :: dx ! tendance de traceur (bas en haut) 28 29 ! Variables locales 30 ! REAL,DIMENSION(klon,klev) :: zed 31 REAL,DIMENSION(klon,klev,klev) :: zmd 32 REAL,DIMENSION(klon,klev,klev) :: za 33 REAL,DIMENSION(klon,klev) :: zmfd,zmfa 34 REAL,DIMENSION(klon,klev) :: zmfp,zmfu 35 INTEGER :: i,k,j 36 REAL :: pdtimeRG 57 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: dtrcv ! tendance totale (bas en haut) 58 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: dtrcvMA ! M-A Filiberti 59 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: trsptd ! tendance du transport 60 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: dtrSscav ! tendance du lessivage courant sat 61 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: dtrsat ! tendance trsp+sat scav 62 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: dtrUscav ! tendance du lessivage courant unsat 63 ! 64 ! Variables locales 65 INTEGER :: i,j,k 66 REAL,DIMENSION(klon,klev) :: dxpres ! difference de pression entre niveau (j+1) et (j) 67 REAL :: pdtimeRG ! pas de temps * gravite 68 ! variables pour les courants satures 69 REAL,DIMENSION(klon,klev,klev) :: zmd 70 REAL,DIMENSION(klon,klev,klev) :: za 71 REAL,DIMENSION(klon,klev,nbtr) :: zmfd,zmfa 72 REAL,DIMENSION(klon,klev,nbtr) :: zmfp,zmfu 73 74 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: zmfd1a 75 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: zmfdam 76 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: zmfphi2 77 78 ! RomP ! les variables sont nettoyees des valeurs aberrantes 79 REAL,DIMENSION(klon,klev) :: Pa, Pm ! pluie AA et mélanges, var temporaire 80 REAL,DIMENSION(klon,klev) :: pmflxs,pmflxr ! pmflxrIN,pmflxsIN sans valeur aberante 81 REAL,DIMENSION(klon,klev) :: mp ! flux de masse 82 REAL,DIMENSION(klon,klev) :: ep ! fraction d'eau convertie en precipitation 83 REAL,DIMENSION(klon,klev) :: evap ! evaporation : variable temporaire 84 REAL,DIMENSION(klon,klev) :: rho !environmental density 85 86 REAL,DIMENSION(klon,klev) :: kappa ! denominateur du au calcul de la matrice 87 ! pour obtenir qd et qp 88 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: qTrdi ! traceurs descente air insature transport MA 89 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: qDi ! traceurs descente insaturees 90 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: qPr ! traceurs colonne precipitante 91 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: qPa ! traceurs dans les precip issues lasc. adiab. 92 REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: qMel ! traceurs dans les precip issues des melanges 93 REAL,DIMENSION(klon,klev,nbtr) :: qMeltmp ! variable temporaire 94 REAL,DIMENSION(klon,klev,nbtr) :: qpmMint 95 REAL,DIMENSION(klon,klev),INTENT(OUT) :: Mint 96 ! tendances 97 REAL :: tdcvMA ! terme de transport de traceur (schema Marie Angele) 98 REAL :: trsptrac ! terme de transport de traceur par l'air 99 REAL :: scavtrac ! terme de lessivage courant sature 100 REAL :: uscavtrac ! terme de lessivage courant insature 101 ! impaction 102 !!! Correction apres discussion Romain P. / Olivier B. 103 !!! REAL,PARAMETER :: rdrop=2.5e-3 ! rayon des gouttes d'eau 104 REAL,PARAMETER :: rdrop=1.e-3 ! rayon des gouttes d'eau 105 !!! 106 REAL,DIMENSION(klon,klev) :: imp ! coefficient d'impaction 107 ! parametres lessivage 108 REAL :: ccntrAA_coef ! \alpha_a : fract aerosols de l'AA convertis en CCN 109 REAL :: ccntrENV_coef ! \beta_m : fract aerosols de l'env convertis en CCN 110 REAL :: coefcoli ! coefficient de collision des gouttes sur les aerosols 111 ! 112 LOGICAL,DIMENSION(klon,klev) :: NO_precip 113 ! LOGICAL :: scavON 114 ! var tmp tests 115 REAL :: conserv 116 real :: conservMA 117 118 ! coefficient lessivage 119 ccntrAA_coef = 0. 120 ccntrENV_coef = 0. 121 coefcoli = 0. 122 123 call getin('ccntrAA_coef',ccntrAA_coef) 124 call getin('ccntrENV_coef',ccntrENV_coef) 125 call getin('coefcoli',coefcoli) 126 print*,'cvltr coef lessivage convectif', ccntrAA_coef,ccntrENV_coef,coefcoli 127 128 ! scavON=.TRUE. 129 ! if(scavON) then 130 ! ccntrAA_coef = 1. 131 ! ccntrENV_coef = 1. 132 ! coefcoli = 1. 133 ! else 134 ! ccntrAA_coef = 0. 135 ! ccntrENV_coef = 0. 136 ! coefcoli = 0. 137 ! endif 138 139 ! ====================================================== 140 ! calcul de l'impaction 141 ! ====================================================== 142 !initialisation 143 do j=1,klev 144 do i=1,klon 145 imp(i,j)=0. 146 enddo 147 enddo 148 ! impaction sur la surface de la colonne de la descente insaturee 149 ! On prend la moyenne des precip entre le niveau i+1 et i 150 ! I=3/4* (P(1+1)+P(i))/2 / (sigd*r*rho_l) 151 ! 1000kg/m3= densité de l'eau 152 ! 0.75e-3 = 3/4 /1000 153 ! Par la suite, I est tout le temps multiplié par sig_d pour avoir l'impaction sur la surface de la maille 154 ! on le néglige ici pour simplifier le code 155 do j=1,klev-1 156 do i=1,klon 157 imp(i,j) = coefcoli*0.75e-3/rdrop *& 158 0.5*(pmflxr(i,j+1)+pmflxs(i,j+1)+pmflxr(i,j)+pmflxs(i,j)) 159 ! rho(i,j)=pplay(i,j)/(rd*te(i,j)) 160 enddo 161 enddo 162 ! 163 ! initialisation pour flux de traceurs, td et autre 164 trsptrac = 0. 165 scavtrac = 0. 166 uscavtrac = 0. 167 168 DO j=1,klev 169 DO i=1,klon 170 zmfd(i,j,it)=0. 171 zmfa(i,j,it)=0. 172 zmfu(i,j,it)=0. 173 zmfp(i,j,it)=0. 174 zmfphi2(i,j,it)=0. 175 zmfd1a(i,j,it)=0. 176 zmfdam(i,j,it)=0. 177 qDi(i,j,it)=0. 178 qPr(i,j,it)=0. 179 qPa(i,j,it)=0. 180 qMel(i,j,it)=0. 181 qMeltmp(i,j,it)=0. 182 qTrdi(i,j,it)=0. 183 kappa(i,j)=0. 184 trsptd(i,j,it)=0. 185 dtrsat(i,j,it)=0. 186 dtrSscav(i,j,it)=0. 187 dtrUscav(i,j,it)=0. 188 dtrcv(i,j,it)=0. 189 dtrcvMA(i,j,it)=0. 190 evap(i,j)=0. 191 dxpres(i,j)=0. 192 qpmMint(i,j,it)=0. 193 Mint(i,j)=0. 194 END DO 195 END DO 196 197 ! suppression des valeurs très faibles (~1e-320) 198 ! multiplication de levaporation pour lavoir par unite de temps 199 ! et par unite de surface de la maille 200 ! -> cv30_unsat : evap : masse evaporee/s/(m2 de la descente) 201 DO j=1,klev 202 DO i=1,klon 203 if(ev(i,j).lt.1.e-16) then 204 evap(i,j)=0. 205 else 206 evap(i,j)=ev(i,j)*sigd(i) 207 endif 208 END DO 209 END DO 210 211 DO j=1,klev 212 DO i=1,klon 213 if(j.lt.klev) then 214 if(epIN(i,j).lt.1.e-32) then 215 ep(i,j)=0. 216 else 217 ep(i,j)=epIN(i,j) 218 endif 219 else 220 ep(i,j)=epmax 221 endif 222 if(mpIN(i,j).lt.1.e-32) then 223 mp(i,j)=0. 224 else 225 mp(i,j)=mpIN(i,j) 226 endif 227 if(pmflxsIN(i,j).lt.1.e-32) then 228 pmflxs(i,j)=0. 229 else 230 pmflxs(i,j)=pmflxsIN(i,j) 231 endif 232 if(pmflxrIN(i,j).lt.1.e-32) then 233 pmflxr(i,j)=0. 234 else 235 pmflxr(i,j)=pmflxrIN(i,j) 236 endif 237 if(wdtrainA(i,j).lt.1.e-32) then 238 Pa(i,j)=0. 239 else 240 Pa(i,j)=wdtrainA(i,j) 241 endif 242 if(wdtrainM(i,j).lt.1.e-32) then 243 Pm(i,j)=0. 244 else 245 Pm(i,j)=wdtrainM(i,j) 246 endif 247 END DO 248 END DO 249 250 !========================================== 251 DO j = klev-1,1,-1 252 DO i = 1,klon 253 NO_precip(i,j) = (pmflxr(i,j+1)+pmflxs(i,j+1)).lt.1.e-10& 254 .and.Pa(i,j).lt.1.e-10.and.Pm(i,j).lt.1.e-10 255 END DO 256 END DO 37 257 38 258 ! ========================================= … … 40 260 ! ========================================= 41 261 !cdir collapse 42 DO j=1,klev43 DO i=1,klon44 ! zed(i,j)=0.45 zmfd(i,j)=0.46 zmfa(i,j)=0.47 zmfu(i,j)=0.48 zmfp(i,j)=0.49 END DO50 END DO51 !cdir collapse52 262 DO k=1,klev 53 DO j=1,klev 54 DO i=1,klon 55 zmd(i,j,k)=0. 56 za (i,j,k)=0. 57 END DO 58 END DO 59 END DO 60 ! entrainement 61 ! DO k=1,klev-1 62 ! DO i=1,klon 63 ! zed(i,k)=max(0.,mp(i,k)-mp(i,k+1)) 64 ! END DO 65 ! END DO 66 263 DO j=1,klev 264 DO i=1,klon 265 zmd(i,j,k)=0. 266 za (i,j,k)=0. 267 END DO 268 END DO 269 END DO 67 270 ! calcul de la matrice d echange 68 271 ! matrice de distribution de la masse entrainee en k 69 272 ! commmentaire RomP : mp > 0 70 273 DO k=1,klev-1 71 274 DO i=1,klon 72 zmd(i,k,k)=max(0.,mp(i,k)-mp(i,k+1)) 275 zmd(i,k,k)=max(0.,mp(i,k)-mp(i,k+1)) ! ~ mk(k) 73 276 END DO 74 277 END DO … … 76 279 DO j=k-1,1,-1 77 280 DO i=1,klon 78 if(mp(i,j+1). ne.0) then79 zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1)) 281 if(mp(i,j+1).gt.1.e-10) then 282 zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1)) !det ~ mk(j)=mk(j+1)*mp(i,j)/mp(i,j+1) 80 283 ENDif 81 284 END DO … … 89 292 END DO 90 293 END DO 294 !!!!! quantite de traceur dans la descente d'air insaturee : 4 juin 2012 295 DO k=1,klev 296 DO j=1,klev-1 297 DO i=1,klon 298 if(mp(i,j+1).gt.1.e-10) then 299 qTrdi(i,j+1,it)=qTrdi(i,j+1,it)+(zmd(i,j+1,k)/mp(i,j+1))*tr(i,k,it) 300 else 301 qTrdi(i,j,it)=0.!tr(i,j,it) 302 endif 303 ENDDO 304 ENDDO 305 ENDDO 306 !!!!! 91 307 ! 92 308 ! rajout du terme lie a l ascendance induite … … 98 314 END DO 99 315 ! 100 ! tendance s101 ! 316 ! tendance courants insatures ! sans lessivage ancien schema 317 ! 102 318 DO k=1,klev 103 319 DO j=1,klev 104 320 DO i=1,klon 105 zmfd(i,j )=zmfd(i,j)+za(i,j,k)*(x(i,k)-x(i,j))321 zmfd(i,j,it)=zmfd(i,j,it)+za(i,j,k)*(tr(i,k,it)-tr(i,j,it)) 106 322 END DO 107 323 END DO … … 109 325 ! 110 326 ! ========================================= 111 ! calcul des tendances liees aux flux satures327 ! calcul des tendances liees aux courants satures j <-> z ; k <-> z' 112 328 ! ========================================= 113 329 DO j=1,klev 114 330 DO i=1,klon 115 zmfa(i,j )=da(i,j)*(x(i,1)-x(i,j))331 zmfa(i,j,it)=da(i,j)*(tr(i,1,it)-tr(i,j,it)) ! da 116 332 END DO 117 333 END DO … … 119 335 DO j=1,klev 120 336 DO i=1,klon 121 zmfp(i,j)=zmfp(i,j)+phi(i,j,k)*(x(i,k)-x(i,j)) 337 zmfp(i,j,it)=zmfp(i,j,it)+phi(i,j,k)*(tr(i,k,it)-tr(i,j,it)) ! phi 338 END DO 339 END DO 340 END DO 341 ! RomP ajout des matrices liees au lessivage 342 DO j=1,klev 343 DO i=1,klon 344 zmfd1a(i,j,it)=d1a(i,j)*tr(i,1,it) ! da1 345 zmfdam(i,j,it)=dam(i,j)*tr(i,1,it) ! dam 346 END DO 347 END DO 348 DO k=1,klev 349 DO j=1,klev 350 DO i=1,klon 351 zmfphi2(i,j,it)=zmfphi2(i,j,it)+phi2(i,j,k)*tr(i,k,it) ! psi 122 352 END DO 123 353 END DO … … 125 355 DO j=1,klev-1 126 356 DO i=1,klon 127 zmfu(i,j )=max(0.,upd(i,j+1)+dnd(i,j+1))*(x(i,j+1)-x(i,j))357 zmfu(i,j,it)=max(0.,upd(i,j+1)+dnd(i,j+1))*(tr(i,j+1,it)-tr(i,j,it)) 128 358 END DO 129 359 END DO 130 360 DO j=2,klev 131 361 DO i=1,klon 132 zmfu(i,j )=zmfu(i,j)+min(0.,upd(i,j)+dnd(i,j))*(x(i,j)-x(i,j-1))133 END DO 134 END DO 135 136 ! =========================================137 ! calcul final des tendances138 ! =========================================362 zmfu(i,j,it)=zmfu(i,j,it)+min(0.,upd(i,j)+dnd(i,j))*(tr(i,j,it)-tr(i,j-1,it)) 363 END DO 364 END DO 365 ! =================================================== 366 ! calcul des tendances liees aux courants insatures 367 ! =================================================== 368 ! pression 139 369 DO k=1, klev 140 370 DO i=1, klon 141 dx (i,k)=paprs(i,k)-paprs(i,k+1)371 dxpres(i,k)=paprs(i,k)-paprs(i,k+1) 142 372 ENDDO 143 373 ENDDO 144 374 pdtimeRG=pdtime*RG 145 !cdir collapse 146 DO k=1, klev 147 DO i=1, klon 148 dx(i,k)=(zmfd(i,k)+zmfu(i,k) & 149 +zmfa(i,k)+zmfp(i,k))*pdtimeRG/dx(i,k) 150 ! print*,'dx',k,dx(i,k) 375 376 ! q_pa et q_pm traceurs issues des courants satures se retrouvant dans les precipitations 377 DO j=1,klev 378 DO i=1,klon 379 if(j.ge.icb(i).and.j.le.inb(i)) then 380 if(clw(i,j).gt.1.e-16) then 381 qPa(i,j,it)=ccntrAA_coef*tr(i,1,it)/clw(i,j) 382 else 383 qPa(i,j,it)=0. 384 endif 385 endif 386 END DO 387 END DO 388 389 ! calcul de q_pm en 2 parties : 390 ! 1) calcul de sa valeur pour un niveau z' donne 391 ! 2) integration sur la verticale sur z' 392 DO j=1,klev 393 DO k=1,j-1 394 DO i=1,klon 395 if(k.ge.icb(i).and.k.le.inb(i).and.& 396 j.le.inb(i)) then 397 if(elij(i,k,j).gt.1.e-16) then 398 qMeltmp(i,j,it)=((1-ep(i,k))*ccntrAA_coef*tr(i,1,it)& 399 *(1.-sij(i,k,j)) +ccntrENV_coef& 400 *tr(i,k,it)*sij(i,k,j)) / elij(i,k,j) 401 else 402 qMeltmp(i,j,it)=0. 403 endif 404 qpmMint(i,j,it)=qpmMint(i,j,it) + qMeltmp(i,j,it)*epmlmMm(i,j,k) 405 Mint(i,j)=Mint(i,j) + epmlmMm(i,j,k) 406 endif ! end if dans nuage 407 END DO 408 END DO 409 END DO 410 411 DO j=1,klev 412 DO i=1,klon 413 if(Mint(i,j).gt.1.e-16) then 414 qMel(i,j,it)=qpmMint(i,j,it)/Mint(i,j) 415 else 416 qMel(i,j,it)=0. 417 endif 418 END DO 419 END DO 420 421 ! calcul de q_d et q_p traceurs de la descente precipitante 422 DO j=klev-1,1,-1 423 DO i=1,klon 424 if(mp(i,j+1).gt.mp(i,j).and.mp(i,j+1).gt.1.e-10) then ! detrainement 425 kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*& 426 (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))& 427 + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j))) 428 429 elseif(mp(i,j).gt.mp(i,j+1).and.mp(i,j).gt.1.e-10) then! entrainement 430 if(j.eq.1) then 431 kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*& 432 (-mp(i,2)-imp(i,j)/RG*dxpres(i,j))& 433 + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j))) 434 else 435 kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*& 436 (-mp(i,j)-imp(i,j)/RG*dxpres(i,j))& 437 + (imp(i,j)/RG*dxpres(i,j))*(evap(i,j)/RG*dxpres(i,j))) 438 endif 439 else 440 kappa(i,j)=1. 441 endif 442 ENDDO 443 ENDDO 444 445 DO j=klev-1,1,-1 446 DO i=1,klon 447 if (abs(kappa(i,j)).lt.1.e-25) then !si denominateur nul (il peut y avoir des mp!=0) 448 kappa(i,j)=1. 449 if(j.eq.1) then 450 qDi(i,j,it)=qDi(i,j+1,it) !orig tr(i,j,it) ! mp(1)=0 donc tout vient de la couche supérieure 451 elseif(mp(i,j+1).gt.mp(i,j).and.mp(i,j+1).gt.1.e-10) then 452 qDi(i,j,it)=qDi(i,j+1,it) 453 elseif(mp(i,j).gt.mp(i,j+1).and.mp(i,j).gt.1.e-10) then! entrainement 454 qDi(i,j,it)=(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))/(-mp(i,j)) 455 else ! si mp (i)=0 et mp(j+1)=0 456 qDi(i,j,it)=tr(i,j,it) ! orig 0. 457 endif 458 459 if(NO_precip(i,j)) then 460 qPr(i,j,it)=0. 461 else 462 qPr(i,j,it)=((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+& 463 Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)& 464 +imp(i,j)/RG*dxpres(i,j)*qDi(i,j,it))/& 465 (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j)) 466 endif 467 else ! denominateur non nul 468 kappa(i,j)=1./kappa(i,j) 469 ! calcul de qd et qp 470 !!jyg (20130119) correction pour le sommet du nuage 471 !! if(j.ge.inb(i)) then !au-dessus du nuage, sommet inclu 472 if(j.gt.inb(i)) then !au-dessus du nuage 473 qDi(i,j,it)=tr(i,j,it) ! pas de descente => environnement = descente insaturee 474 qPr(i,j,it)=0. 475 476 ! vvv premiere couche du modele ou mp(1)=0 ! det tout le temps vvv 477 elseif(j.eq.1) then 478 if(mp(i,2).gt.1.e-10) then !mp(2) non nul -> detrainement (car mp(1) = 0) !ent pas possible 479 if(NO_precip(i,j)) then !pas de precip en (i) 480 qDi(i,j,it)=qDi(i,j+1,it) 481 qPr(i,j,it)=0. 482 else 483 qDi(i,j,it)=kappa(i,j)*(& 484 (-evap(i,j)/RG*dxpres(i,j))*((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+& 485 Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)) +& 486 (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*& 487 (-mp(i,j+1)*qDi(i,j+1,it))) 488 489 qPr(i,j,it)=kappa(i,j)*(& 490 (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))*& 491 ((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+& 492 Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it))& 493 +(-mp(i,j+1)*qDi(i,j+1,it)) * (imp(i,j)/RG*dxpres(i,j))) 494 endif 495 496 else !mp(2) nul -> plus de descente insaturee -> pluie agit sur environnement 497 qDi(i,j,it)=tr(i,j,it) ! orig 0. 498 if(NO_precip(i,j)) then 499 qPr(i,j,it)=0. 500 else 501 qPr(i,j,it)=((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+& 502 Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)& 503 +imp(i,j)/RG*dxpres(i,j)*tr(i,j,it))/& 504 (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j)) 505 endif 506 507 endif !mp(2) nul ou non 508 509 ! vvv (j!=1.and.j.lt.inb(i)) en-dessous du sommet nuage vvv 510 else 511 !------------------------------------------------------------- detrainement 512 if(mp(i,j+1).gt.mp(i,j).and.mp(i,j+1).gt.1.e-10) then !mp(i,j).gt.1.e-10) then 513 if(NO_precip(i,j)) then 514 qDi(i,j,it)=qDi(i,j+1,it) 515 qPr(i,j,it)=0. 516 else 517 qDi(i,j,it)=kappa(i,j)*(& 518 (-evap(i,j)/RG*dxpres(i,j))*((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+& 519 Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)) +& 520 (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*& 521 (-mp(i,j+1)*qDi(i,j+1,it))) 522 ! 523 qPr(i,j,it)=kappa(i,j)*(& 524 (-mp(i,j+1)-imp(i,j)/RG*dxpres(i,j))*& 525 ((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+& 526 Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it))& 527 +(-mp(i,j+1)*qDi(i,j+1,it)) * (imp(i,j)/RG*dxpres(i,j))) 528 endif !precip 529 !------------------------------------------------------------- entrainement 530 elseif(mp(i,j).gt.mp(i,j+1).and.mp(i,j).gt.1.e-10) then 531 if(NO_precip(i,j)) then 532 qDi(i,j,it)=(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))/(-mp(i,j)) 533 qPr(i,j,it)=0. 534 else 535 qDi(i,j,it)=kappa(i,j)*(& 536 (-evap(i,j)/RG*dxpres(i,j))*((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+& 537 Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)) +& 538 (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*& 539 (-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))) 540 ! 541 qPr(i,j,it)=kappa(i,j)*(& 542 (-mp(i,j)-imp(i,j)/RG*dxpres(i,j))*& 543 ((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+& 544 Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it))& 545 +(-mp(i,j+1)*(qDi(i,j+1,it)-tr(i,j,it))-mp(i,j)*tr(i,j,it))*& 546 (imp(i,j)/RG*dxpres(i,j))) 547 endif !precip 548 !------------------------------------------------------------- endif ! ent/det 549 else !mp nul 550 qDi(i,j,it)=tr(i,j,it) ! orig 0. 551 if(NO_precip(i,j)) then 552 qPr(i,j,it)=0. 553 else 554 qPr(i,j,it)=((pmflxr(i,j+1)+pmflxs(i,j+1))*qPr(i,j+1,it)+& 555 Pa(i,j)*qPa(i,j,it)+Pm(i,j)*qMel(i,j,it)& 556 +imp(i,j)/RG*dxpres(i,j)*tr(i,j,it))/& 557 (pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j)) 558 endif 559 endif ! mp nul ou non 560 endif ! condition sur j 561 endif ! kappa 562 ENDDO 563 ENDDO 564 565 !! print test descente insaturee 566 ! DO j=klev,1,-1 567 ! DO i=1,klon 568 ! if(it.eq.3) then 569 ! write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') j,& 570 !! 'zmfdam',zmfdam(i,j,it),'zmfpsi',zmfphi2(i,j,it),& 571 ! 'zmfdam+zmfpsi',zmfdam(i,j,it)+zmfphi2(i,j,it),'qpmMint',qpmMint(i,j,it),& 572 ! 'Pm',Pm(i,j),'Mint',Mint(i,j),& 573 !! 'zmfa',zmfa(i,j,it),'zmfp',zmfp(i,j,it),& 574 ! 'zmfdam',zmfdam(i,j,it),'zmfpsi',zmfphi2(i,j,it),'zmfd1a',zmfd1a(i,j,it) 575 !! 'Pa',Pa(i,j),'eplaMm',eplaMm(i,j) 576 !! 'zmfd1a=da1*qa',zmfd1a(i,j,it),'Pa*qPa',wdtrainA(i,j)*qPa(i,j,it),'da1',d1a(i,j) 577 ! endif 578 ! ENDDO 579 ! ENDDO 580 581 582 ! =================================================== 583 ! calcul final des tendances 584 ! =================================================== 585 586 DO k=klev-1,1,-1 587 DO i=1, klon 588 ! transport 589 tdcvMA=zmfd(i,k,it)+zmfu(i,k,it)+zmfa(i,k,it)+zmfp(i,k,it) ! double comptage des downdraft insatures 590 trsptrac=zmfu(i,k,it)+zmfa(i,k,it)+zmfp(i,k,it) 591 ! lessivage courants satures 592 scavtrac=-ccntrAA_coef*zmfd1a(i,k,it)& 593 -zmfphi2(i,k,it)*ccntrENV_coef& 594 -zmfdam(i,k,it)*ccntrAA_coef 595 ! lessivage courants insatures 596 if(k.le.inb(i).and.k.gt.1) then ! tendances dans le nuage 597 !------------------------------------------------------------- detrainement 598 if(mp(i,k+1).gt.mp(i,k).and.mp(i,k+1).gt.1.e-10) then 599 uscavtrac= (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))& 600 + mp(i,k)*(tr(i,k-1,it)-tr(i,k,it)) 601 ! 602 ! if(it.eq.3) write(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' det incloud',& 603 ! (-mp(i,k)+mp(i,k+1))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+& 604 ! mp(i,k)*(tr(i,k-1,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k),& 605 ! 'mp',mp(i,k) 606 !------------------------------------------------------------- entrainement 607 elseif(mp(i,k).gt.mp(i,k+1).and.mp(i,k).gt.1.e-10) then 608 uscavtrac= mp(i,k)*(tr(i,k-1,it)-tr(i,k,it)) 609 ! 610 ! if(it.eq.3) write(*,'(I2,1X,a,5X,e20.12,82X,a,e20.12)')k,' ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k) 611 !=!------------------------------------------------------------- end ent/det 612 else ! mp(i,k+1)=0. et mp(i,k)=0. pluie directement sur l environnement 613 614 if(NO_precip(i,k)) then 615 uscavtrac=0. 616 ! if(it.eq.3) write(*,'(I2,1X,a,e20.12,82X,a,e20.12)')k,' no P ent incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k) 617 else 618 uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG 619 ! if(it.eq.3) write(*,'(I2,1X,a,3X,e20.12,82X,a,e20.12)')k,' P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k) 620 endif 621 endif ! mp/det/ent 622 !------------------------------------------------------------- premiere couche 623 elseif(k.eq.1) then ! mp(1)=0. 624 if(mp(i,2).gt.1.e-10) then !detrainement 625 uscavtrac= (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it)) !& 626 ! + mp(i,2)*(0.-tr(i,k,it)) 627 ! 628 ! if(it.eq.3) write(*,'(I2,1X,a,e20.12,84X,a,e20.12)')k,' 1 det',& 629 ! (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it))*pdtimeRG/dxpres(i,k)+& 630 ! mp(i,2)*(0.-tr(i,k,it))*pdtimeRG/dxpres(i,k),& 631 ! 'mp',mp(i,k) 632 else ! mp(2) = 0 = mp(1) pas de descente insaturee, rien ne se passe s'il ne pleut pas, sinon pluie->env 633 if(NO_precip(i,1)) then 634 uscavtrac=0. 635 else 636 uscavtrac=-imp(i,k)*tr(i,k,it)*dxpres(i,k)/RG+evap(i,k)*qPr(i,k,it)*dxpres(i,k)/RG 637 endif 638 ! if(it.eq.3) write(*,'(I2,1X,a,2X,e20.12,82X,a,e20.12)')k,'1 P env incloud',uscavtrac*pdtimeRG/dxpres(i,k), 'mp',mp(i,k) 639 endif 640 641 else ! k > INB au-dessus du nuage 642 uscavtrac=0. 643 endif 644 645 ! ===== tendances finales ====== 646 trsptd(i,k,it)=trsptrac*pdtimeRG/dxpres(i,k) ! td transport sans eau dans courants satures 647 dtrSscav(i,k,it)=scavtrac*pdtimeRG/dxpres(i,k) ! td du lessivage dans courants satures 648 dtrUscav(i,k,it)=uscavtrac*pdtimeRG/dxpres(i,k) ! td courant insat 649 dtrsat(i,k,it)=(trsptrac+scavtrac)*pdtimeRG/dxpres(i,k) ! td courant sat 650 dtrcv(i,k,it)=(trsptrac+scavtrac+uscavtrac)*pdtimeRG/dxpres(i,k)!dtrsat(i,k,it)+dtrUscav(i,k,it) td conv 651 !!!!!! 652 dtrcvMA(i,k,it)=tdcvMA*pdtimeRG/dxpres(i,k) ! MA tendance convection 151 653 ENDDO 152 654 ENDDO 153 655 154 656 ! test de conservation du traceur 657 !print*,"_____________________________________________________________" 658 !print*," " 155 659 ! conserv=0. 156 ! DO k=1, klev 660 ! conservMA=0. 661 ! DO k= klev-1,1,-1 157 662 ! DO i=1, klon 158 ! conserv=conserv+d x(i,k)* &663 ! conserv=conserv+dtrcv(i,k,it)* & 159 664 ! (paprs(i,k)-paprs(i,k+1))/RG 665 ! conservMA=conservMA+dtrcvMA(i,k,it)* & 666 ! (paprs(i,k)-paprs(i,k+1))/RG 667 ! 668 ! if(it.eq.3) write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)') k,& 669 ! 'MA td ',dtrcvMA(i,k,it)*dxpres(i,k)/RG,& 670 ! ' td',dtrcv(i,k,it)*dxpres(i,k)/RG,' conservMA ',conservMA,'conserv ',conserv 671 !! 160 672 ! ENDDO 161 673 ! ENDDO 162 ! print *,'conserv',conserv163 674 ! if(it.eq.3) print *,'it',it,'conserv ',conserv,'conservMA ',conservMA 675 164 676 END SUBROUTINE cvltr -
LMDZ5/branches/testing/libf/phylmd/etat0_netcdf.F90
r1707 r1750 99 99 REAL :: dummy 100 100 LOGICAL :: ok_newmicro, ok_journe, ok_mensuel, ok_instan, ok_hf 101 LOGICAL :: ok_LES, ok_ade, ok_aie, aerosol_couple, new_aod, callstats101 LOGICAL :: ok_LES, ok_ade, ok_aie, ok_cdnc, aerosol_couple, new_aod, callstats 102 102 INTEGER :: iflag_radia, flag_aerosol 103 103 REAL :: bl95_b0, bl95_b1, fact_cldcon, facttemps, ratqsbas, ratqshaut … … 136 136 iflag_cldcon, & 137 137 iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, & 138 ok_ade, ok_aie, aerosol_couple,&138 ok_ade, ok_aie, ok_cdnc, aerosol_couple, & 139 139 flag_aerosol, new_aod, & 140 140 bl95_b0, bl95_b1, & … … 437 437 ! Writing 438 438 !******************************************************************************* 439 CALL inidissip(lstardis,nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,tetatemp) 439 CALL inidissip(lstardis, nitergdiv, nitergrot, niterh, tetagdiv, tetagrot, & 440 tetatemp, vert_prof_dissip) 440 441 WRITE(lunout,*)'sortie inidissip' 441 442 itau=0 -
LMDZ5/branches/testing/libf/phylmd/fisrtilp.F90
r1664 r1750 4 4 ! 5 5 SUBROUTINE fisrtilp(dtime,paprs,pplay,t,q,ptconv,ratqs, & 6 d_t, d_q, d_ql, rneb, radliq, rain, snow, &7 pfrac_impa, pfrac_nucl, pfrac_1nucl, &8 frac_impa, frac_nucl, &9 prfl, psfl, rhcl, zqta, fraca, &6 d_t, d_q, d_ql, rneb, radliq, rain, snow, & 7 pfrac_impa, pfrac_nucl, pfrac_1nucl, & 8 frac_impa, frac_nucl, beta, & 9 prfl, psfl, rhcl, zqta, fraca, & 10 10 ztv, zpspsk, ztla, zthl, iflag_cldcon) 11 11 … … 124 124 REAL zprec_cond(klon) 125 125 !AA 126 ! RomP >>> 15 nov 2012 127 REAL beta(klon,klev) ! taux de conversion de l'eau cond 128 ! RomP <<< 126 129 REAL zmair, zcpair, zcpeau 127 130 ! Pour la conversion eau-neige … … 171 174 pfrac_1nucl(i,k)=1. 172 175 pfrac_impa(i,k)=1. 176 beta(i,k)=0. !RomP initialisation 173 177 ENDDO 174 178 ENDDO … … 549 553 DO i = 1,klon 550 554 ! 555 if(zcond(i).gt.zoliq(i)+1.e-10) then 556 beta(i,k) = (zcond(i)-zoliq(i))/zcond(i)/dtime 557 else 558 beta(i,k) = 0. 559 endif 551 560 zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0) & 552 561 * (paprs(i,k)-paprs(i,k+1))/RG -
LMDZ5/branches/testing/libf/phylmd/ini_histrac.h
r1664 r1750 4 4 IF (ecrit_tra>0.) THEN 5 5 !$OMP MASTER 6 CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian) 6 !!! CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian) 7 ! correction pour l heure initiale !jyg 8 ! !jyg 9 CALL ymds2ju(annee_ref, 1, day_ref, hour, zjulian) !jyg 10 7 11 CALL histbeg_phy("histrac", itau_phy, zjulian, pdtphys,nhori, nid_tra) 8 CALL histvert(nid_tra, "presnivs", "Vertical levels", " mb",klev, presnivs, nvert)12 CALL histvert(nid_tra, "presnivs", "Vertical levels", "Pa",klev, presnivs, nvert,"down") 9 13 10 14 zsto = pdtphys … … 17 21 "kg m-2", iim, jj_nb, nhori, klev, 1, klev, nvert, 32, "ave(X)", & 18 22 zsto,zout) 23 ! RomP >>> 24 CALL histdef(nid_tra, "sourceBE", "source 7Be", & 25 "at/kgA/s", iim, jj_nb, nhori, klev, 1, klev, nvert, 32, "ave(X)", & 26 zsto,zout) 27 ! RomP <<< 19 28 20 29 !TRACEURS … … 30 39 IF (lessivage .AND. aerosol(it)) THEN 31 40 CALL histdef(nid_tra, "fl"//tname(iiq),"Flux "//ttext(iiq), & 32 "U/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 33 "ave(X)", zsto,zout) 34 END IF 41 "at/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 42 "ave(X)", zsto,zout) 43 CALL histdef(nid_tra, "d_tr_ls_"//tname(iiq), & 44 "tendance lessivage large scale"// ttext(iiq), "?",& 45 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 46 "ave(X)", zsto,zout) 47 CALL histdef(nid_tra, "d_tr_insc_"//tname(iiq), & 48 "tendance lessivage large scale"// ttext(iiq), "?",& 49 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 50 "ave(X)", zsto,zout) 51 CALL histdef(nid_tra, "d_tr_bcscav_"//tname(iiq), & 52 "tendance lessivage large scale"// ttext(iiq), "?",& 53 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 54 "ave(X)", zsto,zout) 55 CALL histdef(nid_tra, "d_tr_evls_"//tname(iiq), & 56 "tendance lessivage large scale"// ttext(iiq), "?",& 57 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 58 "ave(X)", zsto,zout) 59 ! Tracer concentration in LS precipitation at surface 60 CALL histdef(nid_tra, "qpr_ls_"//tname(iiq), & 61 "concentration in LS precip"// ttext(iiq), "at/kgw", & 62 iim,jj_nb,nhori, 1,1,1, -99, 32, & 63 "ave(X)", zsto,zout) 64 END IF 35 65 36 66 ! TD THERMIQUES … … 50 80 ENDIF 51 81 82 ! RomP >>> 83 IF (iflag_con.EQ.30) THEN 84 CALL histdef(nid_tra, "d_tr_cvMA_"//tname(iiq), & 85 "tendance convection"// ttext(iiq), "?",& 86 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 87 "ave(X)", zsto,zout) 88 CALL histdef(nid_tra, "d_tr_trsp_"//tname(iiq), & 89 "tendance transport "// ttext(iiq), "at/kga", & 90 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 91 "ave(X)", zsto,zout) 92 CALL histdef(nid_tra, "d_tr_sscav_"//tname(iiq), & 93 "tendance lessivage flux satures "// ttext(iiq), "at/kga", & 94 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 95 "ave(X)", zsto,zout) 96 CALL histdef(nid_tra, "d_tr_sat_"//tname(iiq), & 97 "tendance flux satures "// ttext(iiq), "at/kga", & 98 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 99 "ave(X)", zsto,zout) 100 CALL histdef(nid_tra, "d_tr_uscav_"//tname(iiq), & 101 "tendance flux insatures "// ttext(iiq), "at/kga", & 102 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 103 "ave(X)", zsto,zout) 104 CALL histdef(nid_tra, "tr_pr_"//tname(iiq), & 105 "concentration dans precip"// ttext(iiq), "at/kga", & 106 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 107 "ave(X)", zsto,zout) 108 CALL histdef(nid_tra, "tr_aa_"//tname(iiq), & 109 "concentration precip issu AA"// ttext(iiq), "at/kga", & 110 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 111 "ave(X)", zsto,zout) 112 CALL histdef(nid_tra, "tr_mel_"//tname(iiq), & 113 "concentration precip issu melange"// ttext(iiq), "at/kga", & 114 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 115 "ave(X)", zsto,zout) 116 CALL histdef(nid_tra, "tr_di_"//tname(iiq), & 117 "concentration dans descente insaturee"// ttext(iiq), "at/kga", & 118 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 119 "ave(X)", zsto,zout) 120 CALL histdef(nid_tra, "tr_trspdi_"//tname(iiq), & 121 "conc descente insaturee MA"// ttext(iiq), "at/kga", & 122 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 123 "ave(X)", zsto,zout) 124 CALL histdef(nid_tra, "zmfd1a_"//tname(iiq), & 125 "zmfd1a"// ttext(iiq), "_", & 126 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 127 "ave(X)", zsto,zout) 128 CALL histdef(nid_tra, "zmfphi2_"//tname(iiq), & 129 "zmfphi2"// ttext(iiq), "_", & 130 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 131 "ave(X)", zsto,zout) 132 CALL histdef(nid_tra, "zmfdam_"//tname(iiq), & 133 "zmfdam"// ttext(iiq), "_", & 134 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 135 "ave(X)", zsto,zout) 136 ENDIF 137 ! RomP <<< 138 CALL histdef(nid_tra, "dtrdyn_"//tname(iiq), & 139 "td dyn tra"// ttext(iiq), "at/kga", & 140 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 141 "ave(X)", zsto,zout) 142 ! TD decroissance radioactive 143 CALL histdef(nid_tra, "d_tr_dec_"//tname(iiq), & 144 "tendance decroi radio "// ttext(iiq), "", & 145 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 146 "ave(X)", zsto,zout) 147 52 148 ! TD COUCHE-LIMITE 149 IF (couchelimite) THEN 53 150 CALL histdef(nid_tra, "d_tr_cl_"//tname(iiq), & 54 151 "tendance couche limite"// ttext(iiq), "?", & 55 152 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 56 153 "ave(X)", zsto,zout) 154 ! Dry deposit (1st layer and surface) 155 CALL histdef(nid_tra, "d_tr_dry_"//tname(iiq), & 156 "tendancy dry deposit"// ttext(iiq), "at/kga/step", & 157 iim,jj_nb,nhori, 1,1,1, -99, 32, & 158 "ave(X)", zsto,zout) 159 CALL histdef(nid_tra, "flux_tr_dry_"//tname(iiq), & 160 "dry deposit at surf (downward)"// ttext(iiq), "at/m2/step", & 161 iim,jj_nb,nhori, 1,1,1, -99, 32, & 162 "ave(X)", zsto,zout) 163 ENDIF 57 164 ENDDO 165 166 CALL histdef(nid_tra, "Mint", "Mint","", & 167 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 168 "inst(X)", zout,zout) 169 CALL histdef(nid_tra, "frac_impa", "frac_impa","", & 170 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 171 "inst(X)", zout,zout) 172 CALL histdef(nid_tra, "frac_nucl", "frac_nucl","", & 173 iim,jj_nb,nhori, klev,1,klev,nvert, 32, & 174 "inst(X)", zout,zout) 58 175 !--------------- 59 176 ! -
LMDZ5/branches/testing/libf/phylmd/init_be.F90
r1279 r1750 1 1 !$Id $ 2 2 3 SUBROUTINE init_be(pctsrf,masktr,tautr,vdeptr,scavtr,srcbe) 3 SUBROUTINE init_be(pctsrf,pplay,masktr,tautr,vdeptr,scavtr,srcbe) 4 !!!SUBROUTINE init_be(pctsrf,masktr,tautr,vdeptr,scavtr,srcbe) 4 5 5 6 USE dimphy … … 26 27 ! 27 28 REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf !Pourcentage de sol (f(nature du sol)) 29 REAL,DIMENSION(klon,klev), INTENT(IN) :: pplay ! Pressions en milieu de couches 28 30 ! 29 31 ! Output Arguments … … 37 39 ! Local Variables 38 40 ! 41 !!! INTEGER :: iref ! numero d'un point oceanique donnant la grille de pression de reference 39 42 REAL,DIMENSION(klon) :: rlatgeo ! latitudes geomagnetiques de la grille 40 43 REAL :: glt ! latitude du pole geomagnetique 41 44 REAL :: glg ! longitude du pole geomagnetique 42 45 REAL :: latgeo,qcos 43 INTEGER :: k,i 46 INTEGER :: k,i, kref, k2 47 INTEGER :: nref 48 PARAMETER (nref=39) 49 REAL,DIMENSION(nref) :: pref ! grille de pression de reference (bas des couches) 50 DATA pref / & 51 101249.99999999994, 100387.17261011522, 99447.35334189111, 98357.43412194174, & 52 97046.47707771382, 95447.1116450629, 93496.85259615642, 91139.46548240296, & 53 88326.55568744117, 85019.60710580258, 81192.7404556645, 76836.48366938648, & 54 71962.81275769137, 66611.56331321516, 60857.914829743604, 54819.84484441629, & 55 48663.06257114699, 42598.95465845692, 36869.104365898806, 31709.927925633147, & 56 27296.757208636915, 23682.282929080895, 20766.025578936627, 18336.105961406534, & 57 16178.04816768436, 14168.286905562818, 12275.719926478887, 10507.798835225762, & 58 8876.585404909414, 7391.283929569539, 6057.514475749798, 4877.165909157005, & 59 3848.34936408203, 2965.444753540027, 2219.2391544640013, 1597.15366044666, & 60 1083.5531161631498, 660.1311067852655, 306.36072267002805 / 61 !$OMP THREADPRIVATE(pref) 44 62 45 63 WRITE(*,*)'PASSAGE init_be ...' 46 64 47 ! Source actuellement definie pour klev = 19 et klev >= 39 48 IF (klev /= 19 .AND. klev<39) CALL abort_gcm("init_be","Source du be7 necessite klev=19 ou klev>=39",1) 49 ! 65 ! la source est maintenant définie independemment de la valeur de klev. 66 !!! Source actuellement definie pour klev = 19 et klev >= 39 67 !! IF (klev /= 19 .AND. klev<39) CALL abort_gcm("init_be","Source du be7 necessite klev=19 ou klev>=39",1) 68 !!! 50 69 ! Definition des constantes 51 70 ! ------------------------- … … 53 72 vdeptr = 1.E-3 54 73 scavtr = 0.5 74 !!!!!jyg le 13/03/2013; puis 20/03/2013 : pref est maintenant une table. 75 !!! 76 !!! Recherche d'un point rlat=0., rlon=180. 77 !! iref=(klon+1)/2 78 !! DO i = 1,klon 79 !! IF (abs(rlatd(i)) .LT. 0.15 .AND. cos(rlond(i)) .LT. -0.85) iref=i 80 !! ENDDO 81 !!! 82 !!! Grille de pression de reference (= approx de sommets de couches) 83 !! pref(1) = pplay(iref,1)+0.5*(pplay(iref,1)-pplay(iref,2)) 84 !! DO k = 2,klev 85 !! pref(k) = 0.5*(pplay(iref,k-1)+pplay(iref,k)) 86 !! ENDDO 87 !!! 55 88 56 89 WRITE(*,*) '-------------- SOURCE DE BERYLLIUM ------------------- ' … … 77 110 ! 3-mettre la source de Be ds la bonne unite (en at/kgA/s) 78 111 ! 79 glt =78.5*rpi/180.80 glg =69.0*rpi/180.112 glt = 78.5*rpi/180. 113 glg = -69.0*rpi/180. 81 114 82 115 DO i = 1,klon 83 116 qcos=sin(glt)*sin(rlatd(i)) 84 qcos=qcos+cos(glt)*cos(rlatd(i))*cos(rlond(i)+glg) 117 !!jyg 118 !! qcos=qcos+cos(glt)*cos(rlatd(i))*cos(rlond(i)+glg) 119 qcos=qcos+cos(glt)*cos(rlatd(i))*cos(rlond(i)-glg) 120 !!jyg end 85 121 IF ( qcos .LT. -1.) qcos = -1. 86 122 IF ( qcos .GT. 1.) qcos = 1. … … 88 124 ENDDO 89 125 90 !=========================== 91 ! Cas 19 niveaux verticaux 92 !=========================== 93 IF (klev.eq.19) then 126 !!!=========================== 127 !!! Cas 19 niveaux verticaux 128 !!!=========================== 129 !! IF (klev.eq.19) then 130 !! DO k = 1,klev 131 !! DO i = 1,klon 132 !!!!!jyg le 13/03/2013 133 !!! 134 !!! k est le niveau dans la grille locale 135 !!! Determination du niveau kref dans la grille de refernce 136 !! kref = 1 137 !! DO k2 = 1,klev 138 !! IF (pref(k2) .GT. pplay(i,k)) kref=k2 139 !! ENDDO 140 !!!!! 141 !! latgeo=(180./rpi)*abs(rlatgeo(i)) 142 !! IF ( kref .EQ. 1 ) THEN 143 !! IF (latgeo.GE.50.0) srcbe(i,k)=0.1 144 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.09 145 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.07 146 !! END IF 147 !! IF ( kref .EQ. 2 ) THEN 148 !! IF (latgeo.GE.50.0) srcbe(i,k)=0.12 149 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.1 150 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.09 151 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.07 152 !! END IF 153 !! IF ( kref .EQ. 3 ) THEN 154 !! IF (latgeo.GE.50.0) srcbe(i,k)=0.14 155 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.12 156 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.1 157 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.09 158 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.07 159 !! END IF 160 !! IF ( kref .EQ. 4 ) THEN 161 !! IF (latgeo.GE.50.0) srcbe(i,k)=0.175 162 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.16 163 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.14 164 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.12 165 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.1 166 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.09 167 !! END IF 168 !! IF ( kref .EQ. 5 ) THEN 169 !! IF (latgeo.GE.50.0) srcbe(i,k)=0.28 170 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.26 171 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.23 172 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.175 173 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.14 174 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.12 175 !! END IF 176 !! IF ( kref .EQ. 6 ) THEN 177 !! IF (latgeo.GE.50.0) srcbe(i,k)=0.56 178 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.49 179 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.42 180 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.28 181 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.26 182 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.245 183 !! END IF 184 !! IF ( kref .EQ. 7 ) THEN 185 !! IF (latgeo.GE.50.0) srcbe(i,k)=1.05 186 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.875 187 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.7 188 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.52 189 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.44 190 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.385 191 !! END IF 192 !! IF ( kref .EQ. 8 ) THEN 193 !! IF (latgeo.GE.50.0) srcbe(i,k)=2. 194 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=1.8 195 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=1.5 196 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=1. 197 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.8 198 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.75 199 !! END IF 200 !! IF ( kref .EQ. 9 ) THEN 201 !! IF (latgeo.GE.50.0) srcbe(i,k)=4. 202 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=3.5 203 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=3. 204 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=2.5 205 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=1.8 206 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=1.4 207 !! END IF 208 !! IF ( kref .EQ. 10 ) THEN 209 !! IF (latgeo.GE.50.0) srcbe(i,k)=8.5 210 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=8. 211 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=7. 212 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=4.5 213 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=3.5 214 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=3. 215 !! END IF 216 !! IF ( kref .EQ. 11 ) THEN 217 !! IF (latgeo.GE.50.0) srcbe(i,k)=17. 218 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=15. 219 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=11. 220 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=8. 221 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=5. 222 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=4. 223 !! END IF 224 !! IF ( kref .EQ. 12 ) THEN 225 !! IF (latgeo.GE.50.0) srcbe(i,k)=25. 226 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=22. 227 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=17. 228 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=11. 229 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=7.5 230 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7. 231 !! END IF 232 !! IF ( kref .EQ. 13 ) THEN 233 !! IF (latgeo.GE.60.0) srcbe(i,k)=33. 234 !! IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=32. 235 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=30. 236 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=22. 237 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=15. 238 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=11. 239 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=8. 240 !! END IF 241 !! IF ( kref .EQ. 14 ) THEN 242 !! IF (latgeo.GE.60.0) srcbe(i,k)=48. 243 !! IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=45. 244 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=36. 245 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=26. 246 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=17.5 247 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=12.5 248 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10. 249 !! END IF 250 !! IF ( kref .EQ. 15 ) THEN 251 !! IF (latgeo.GE.70.0) srcbe(i,k)=58. 252 !! IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=57. 253 !! IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=50. 254 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=38. 255 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=25. 256 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=15. 257 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=12.5 258 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10. 259 !! END IF 260 !! IF ( kref .EQ. 16 ) THEN 261 !! IF (latgeo.GE.70.0) srcbe(i,k)=70. 262 !! IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=65. 263 !! IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=50. 264 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=32. 265 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=20. 266 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=13. 267 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=9. 268 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.5 269 !! END IF 270 !! IF ( kref .GE. 17 ) THEN 271 !! IF (latgeo.GE.70.0) srcbe(i,k)=80. 272 !! IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=70. 273 !! IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=45. 274 !! IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=27. 275 !! IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=17.5 276 !! IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=12. 277 !! IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=8. 278 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7. 279 !! END IF 280 !! END DO 281 !! END DO 282 !! END IF ! fin de 19 niveaux verticaux 283 !! 284 !!!!!! IF (klev .ge. 39) then 94 285 DO k = 1,klev 95 286 DO i = 1,klon 287 !!!jyg le 13/03/2013 288 ! 289 ! k est le niveau dans la grille locale 290 ! Determination du niveau kref dans la grille de refernce 291 kref = 1 292 DO k2 = 1,nref 293 IF (pref(k2) .GT. pplay(i,k)) kref=k2 294 ENDDO 295 !!! 96 296 latgeo=(180./rpi)*abs(rlatgeo(i)) 97 IF ( k .EQ. 1 ) THEN 297 IF ( kref .LE. 4 ) THEN 298 IF (latgeo.GE.50.0) srcbe(i,k)=0.07 299 END IF 300 IF ( kref .EQ. 5 ) THEN 98 301 IF (latgeo.GE.50.0) srcbe(i,k)=0.1 99 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.09 100 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.07 101 END IF 102 IF ( k .EQ. 2 ) THEN 103 IF (latgeo.GE.50.0) srcbe(i,k)=0.12 104 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.1 105 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.09 302 IF (latgeo.GE.20.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.09 106 303 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.07 107 304 END IF 108 IF ( k .EQ. 3) THEN305 IF ( kref .EQ. 6 ) THEN 109 306 IF (latgeo.GE.50.0) srcbe(i,k)=0.14 110 307 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.12 … … 113 310 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.07 114 311 END IF 115 IF ( k .EQ. 4 ) THEN 116 IF (latgeo.GE.50.0) srcbe(i,k)=0.175 117 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.16 118 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.14 119 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.12 120 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.1 121 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.09 122 END IF 123 IF ( k .EQ. 5 ) THEN 124 IF (latgeo.GE.50.0) srcbe(i,k)=0.28 125 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.26 126 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.23 127 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.175 128 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.14 129 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.12 130 END IF 131 IF ( k .EQ. 6 ) THEN 132 IF (latgeo.GE.50.0) srcbe(i,k)=0.56 133 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.49 134 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.42 135 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.28 136 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.26 137 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.245 138 END IF 139 IF ( k .EQ. 7 ) THEN 140 IF (latgeo.GE.50.0) srcbe(i,k)=1.05 141 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.875 142 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.7 143 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.52 144 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.44 145 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.385 146 END IF 147 IF ( k .EQ. 8 ) THEN 148 IF (latgeo.GE.50.0) srcbe(i,k)=2. 149 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=1.8 150 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=1.5 151 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=1. 152 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.8 153 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.75 154 END IF 155 IF ( k .EQ. 9 ) THEN 156 IF (latgeo.GE.50.0) srcbe(i,k)=4. 157 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=3.5 158 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=3. 159 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=2.5 160 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=1.8 161 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=1.4 162 END IF 163 IF ( k .EQ. 10 ) THEN 164 IF (latgeo.GE.50.0) srcbe(i,k)=8.5 165 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=8. 166 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=7. 167 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=4.5 168 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=3.5 169 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=3. 170 END IF 171 IF ( k .EQ. 11 ) THEN 172 IF (latgeo.GE.50.0) srcbe(i,k)=17. 173 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=15. 174 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=11. 175 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=8. 176 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=5. 177 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=4. 178 END IF 179 IF ( k .EQ. 12 ) THEN 180 IF (latgeo.GE.50.0) srcbe(i,k)=25. 181 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=22. 182 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=17. 183 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=11. 184 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=7.5 185 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7. 186 END IF 187 IF ( k .EQ. 13 ) THEN 188 IF (latgeo.GE.60.0) srcbe(i,k)=33. 189 IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=32. 190 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=30. 191 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=22. 192 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=15. 193 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=11. 194 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=8. 195 END IF 196 IF ( k .EQ. 14 ) THEN 197 IF (latgeo.GE.60.0) srcbe(i,k)=48. 198 IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=45. 199 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=36. 200 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=26. 201 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=17.5 202 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=12.5 203 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10. 204 END IF 205 IF ( k .EQ. 15 ) THEN 206 IF (latgeo.GE.70.0) srcbe(i,k)=58. 207 IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=57. 208 IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=50. 209 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=38. 210 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=25. 211 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=15. 212 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=12.5 213 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10. 214 END IF 215 IF ( k .EQ. 16 ) THEN 216 IF (latgeo.GE.70.0) srcbe(i,k)=70. 217 IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=65. 218 IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=50. 219 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=32. 220 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=20. 221 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=13. 222 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=9. 223 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.5 224 END IF 225 IF ( k .GE. 17 ) THEN 226 IF (latgeo.GE.70.0) srcbe(i,k)=80. 227 IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=70. 228 IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=45. 229 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=27. 230 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=17.5 231 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=12. 232 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=8. 233 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7. 234 END IF 235 END DO 236 END DO 237 END IF ! fin de 19 niveaux verticaux 238 239 !================================ 240 ! Cas 39 niveaux verticaux 241 !================================ 242 IF (klev .ge. 39) then 243 DO k = 1,klev 244 DO i = 1,klon 245 latgeo=(180./rpi)*abs(rlatgeo(i)) 246 IF ( k .LE. 4 ) THEN 247 IF (latgeo.GE.50.0) srcbe(i,k)=0.07 248 END IF 249 IF ( k .EQ. 5 ) THEN 250 IF (latgeo.GE.50.0) srcbe(i,k)=0.1 251 IF (latgeo.GE.20.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.09 252 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.07 253 END IF 254 IF ( k .EQ. 6 ) THEN 255 IF (latgeo.GE.50.0) srcbe(i,k)=0.14 256 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.12 257 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.1 258 IF (latgeo.GE.20.0 .and. latgeo.LT.30.0) srcbe(i,k)=0.09 259 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=0.07 260 END IF 261 IF ( k .EQ. 7 ) THEN 312 IF ( kref .EQ. 7 ) THEN 262 313 IF (latgeo.GE.50.0) srcbe(i,k)=0.16 263 314 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.16 … … 267 318 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.09 268 319 END IF 269 IF ( k .EQ. 8 ) THEN320 IF ( kref .EQ. 8 ) THEN 270 321 IF (latgeo.GE.50.0) srcbe(i,k)=0.175 271 322 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.16 … … 275 326 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.1 276 327 END IF 277 IF ( k .EQ. 9 ) THEN328 IF ( kref .EQ. 9 ) THEN 278 329 IF (latgeo.GE.50.0) srcbe(i,k)=0.245 279 330 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.21 … … 283 334 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.12 284 335 END IF 285 IF ( k .EQ. 10 ) THEN336 IF ( kref .EQ. 10 ) THEN 286 337 IF (latgeo.GE.50.0) srcbe(i,k)=0.31 287 338 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.28 … … 291 342 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.14 292 343 END IF 293 IF ( k .EQ. 11 ) THEN344 IF ( kref .EQ. 11 ) THEN 294 345 IF (latgeo.GE.50.0) srcbe(i,k)=0.35 295 346 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.3 … … 299 350 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.16 300 351 END IF 301 IF ( k .EQ. 12 ) THEN352 IF ( kref .EQ. 12 ) THEN 302 353 IF (latgeo.GE.40.0) srcbe(i,k)=0.5 303 354 IF (latgeo.GE.30.0 .and. latgeo.LT.40.0) srcbe(i,k)=0.4 … … 306 357 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.25 307 358 END IF 308 IF ( k .EQ. 13 ) THEN359 IF ( kref .EQ. 13 ) THEN 309 360 IF (latgeo.GE.50.0) srcbe(i,k)=0.8 310 361 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=0.7 … … 314 365 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.35 315 366 END IF 316 IF ( k .EQ. 14 ) THEN367 IF ( kref .EQ. 14 ) THEN 317 368 IF (latgeo.GE.50.0) srcbe(i,k)=1.2 318 369 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=1. … … 322 373 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.4 323 374 END IF 324 IF ( k .EQ. 15 ) THEN375 IF ( kref .EQ. 15 ) THEN 325 376 IF (latgeo.GE.60.0) srcbe(i,k)=1.75 326 377 IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=1.8 … … 331 382 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.65 332 383 END IF 333 IF ( k .EQ. 16 ) THEN384 IF ( kref .EQ. 16 ) THEN 334 385 IF (latgeo.GE.50.0) srcbe(i,k)=3. 335 386 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=2.5 … … 339 390 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=0.9 340 391 END IF 341 IF ( k .EQ. 17 ) THEN392 IF ( kref .EQ. 17 ) THEN 342 393 IF (latgeo.GE.50.0) srcbe(i,k)=4. 343 394 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=3. … … 347 398 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=1.4 348 399 END IF 349 IF ( k .EQ. 18 ) THEN400 IF ( kref .EQ. 18 ) THEN 350 401 IF (latgeo.GE.50.0) srcbe(i,k)=7. 351 402 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=6. … … 355 406 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=2. 356 407 END IF 357 IF ( k .EQ. 19 ) THEN408 IF ( kref .EQ. 19 ) THEN 358 409 IF (latgeo.GE.50.0) srcbe(i,k)=8.5 359 410 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=8. … … 363 414 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=3. 364 415 END IF 365 IF ( k .EQ. 20 ) THEN416 IF ( kref .EQ. 20 ) THEN 366 417 IF (latgeo.GE.50.0) srcbe(i,k)=12.5 367 418 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=12. … … 371 422 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=3.5 372 423 END IF 373 IF ( k .EQ. 21 ) THEN424 IF ( kref .EQ. 21 ) THEN 374 425 IF (latgeo.GE.50.0) srcbe(i,k)=16. 375 426 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=13. … … 379 430 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=4. 380 431 END IF 381 IF ( k .EQ. 22 ) THEN432 IF ( kref .EQ. 22 ) THEN 382 433 IF (latgeo.GE.50.0) srcbe(i,k)=20. 383 434 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=17.5 … … 387 438 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=4.5 388 439 END IF 389 IF ( k .EQ. 23 ) THEN440 IF ( kref .EQ. 23 ) THEN 390 441 IF (latgeo.GE.50.0) srcbe(i,k)=25. 391 442 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=22. … … 395 446 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=6. 396 447 END IF 397 IF ( k .EQ. 24 ) THEN448 IF ( kref .EQ. 24 ) THEN 398 449 IF (latgeo.GE.50.0) srcbe(i,k)=28. 399 450 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=26. … … 403 454 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7. 404 455 END IF 405 IF ( k .EQ. 25 ) THEN456 IF ( kref .EQ. 25 ) THEN 406 457 IF (latgeo.GE.50.0) srcbe(i,k)=33. 407 458 IF (latgeo.GE.40.0 .and. latgeo.LT.50.0) srcbe(i,k)=28. … … 411 462 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=8.5 412 463 END IF 413 IF ( k .EQ. 26 ) THEN464 IF ( kref .EQ. 26 ) THEN 414 465 IF (latgeo.GE.60.0) srcbe(i,k)=38. 415 466 IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=36. … … 419 470 IF (latgeo.GE.10.0 .and. latgeo.LT.20.0) srcbe(i,k)=11.5 420 471 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10. 421 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=6. 422 END IF 423 IF ( k .EQ. 27 ) THEN 472 !!jyg 473 !! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=6. 474 !!jyg end 475 END IF 476 IF ( kref .EQ. 27 ) THEN 424 477 IF (latgeo.GE.60.0) srcbe(i,k)=46. 425 478 IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=44. … … 430 483 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10. 431 484 END IF 432 IF ( k .EQ. 28 ) THEN485 IF ( kref .EQ. 28 ) THEN 433 486 IF (latgeo.GE.60.0) srcbe(i,k)=53. 434 487 IF (latgeo.GE.50.0 .and. latgeo.LT.60.0) srcbe(i,k)=48. … … 439 492 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10. 440 493 END IF 441 IF ( k .EQ. 29 ) THEN494 IF ( kref .EQ. 29 ) THEN 442 495 IF (latgeo.GE.70.0) srcbe(i,k)=58. 443 496 IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=56. … … 449 502 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=10. 450 503 END IF 451 IF ( k .EQ. 30 ) THEN504 IF ( kref .EQ. 30 ) THEN 452 505 IF (latgeo.GE.70.0) srcbe(i,k)=65. 453 506 IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=60. … … 459 512 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=9. 460 513 END IF 461 IF ( k .EQ. 31 ) THEN514 IF ( kref .EQ. 31 ) THEN 462 515 IF (latgeo.GE.70.0) srcbe(i,k)=70. 463 516 IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=62. … … 469 522 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.6 470 523 END IF 471 IF ( k .EQ. 32 ) THEN524 IF ( kref .EQ. 32 ) THEN 472 525 IF (latgeo.GE.70.0) srcbe(i,k)=80. 473 526 IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=60. … … 479 532 IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=7.4 480 533 END IF 481 IF ( k .GE. 33 ) THEN534 IF ( kref .GE. 33 ) THEN 482 535 IF (latgeo.GE.70.0) srcbe(i,k)=80. 483 536 IF (latgeo.GE.60.0 .and. latgeo.LT.70.0) srcbe(i,k)=70. … … 491 544 END DO 492 545 END DO 493 END IF ! fin de 39 niveaux verticaux546 !!!!!! END IF ! fin de 39 niveaux verticaux 494 547 495 548 … … 503 556 ! 1/(60*1.295) = 0.01287 504 557 srcbe(i,k)=srcbe(i,k)*0.01287 558 !! print *,' k, srcbe(i,k) ', & 559 !! k, srcbe(i,k) 505 560 ! La source est at/min/m3 -> at/s/m3 506 561 ! srcbe(i,k)=srcbe(i,k)*0.0166667 -
LMDZ5/branches/testing/libf/phylmd/newmicro.F
r1525 r1750 2 2 3 3 4 5 4 ! 6 SUBROUTINE newmicro (paprs, pplay,ok_newmicro, 5 SUBROUTINE newmicro (ok_cdnc, bl95_b0, bl95_b1, 6 . paprs, pplay, 7 7 . t, pqlwp, pclc, pcltau, pclemi, 8 8 . pch, pcl, pcm, pct, pctlwp, 9 s xflwp, xfiwp, xflwc, xfiwc, 10 e ok_aie, 11 e mass_solu_aero, mass_solu_aero_pi, 12 e bl95_b0, bl95_b1, 13 s cldtaupi, re, fl, reliq, reice) 14 9 . xflwp, xfiwp, xflwc, xfiwc, 10 . mass_solu_aero, mass_solu_aero_pi, 11 . pcldtaupi, re, fl, reliq, reice) 12 c 15 13 USE dimphy 16 14 USE phys_local_var_mod, only: scdnc,cldncl,reffclwtop,lcc, … … 21 19 c====================================================================== 22 20 c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930910 21 c O. Boucher (LMD/CNRS) mise a jour en 201212 23 22 c Objet: Calculer epaisseur optique et emmissivite des nuages 24 23 c====================================================================== 25 24 c Arguments: 25 c ok_cdnc-input-L-flag pour calculer les rayons a partir des aerosols 26 c 26 27 c t-------input-R-temperature 27 c pqlwp---input-R-eau liquide nuageuse dans l'atmosphere (kg/kg)28 c pqlwp---input-R-eau liquide nuageuse dans l'atmosphere dans la partie nuageuse (kg/kg) 28 29 c pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1) 29 c30 c ok_aie--input-L-apply aerosol indirect effect or not31 30 c mass_solu_aero-----input-R-total mass concentration for all soluble aerosols[ug/m^3] 32 c mass_solu_aero_pi--input-R-dito, pre-industrial value 33 c bl95_b0-input-R-a parameter, may be varied for tests (s-sea, l-land) 34 c bl95_b1-input-R-a parameter, may be varied for tests ( -"- ) 31 c mass_solu_aero_pi--input-R-ditto, pre-industrial value 32 c 33 c bl95_b0-input-R-a PARAMETER, may be varied for tests (s-sea, l-land) 34 c bl95_b1-input-R-a PARAMETER, may be varied for tests ( -"- ) 35 35 c 36 c cldtaupi-output-R-pre-industrial value of cloud optical thickness,37 c needed for the diagnostics of the aerosol indirect38 c radiative forcing (see radlwsw)39 36 c re------output-R-Cloud droplet effective radius multiplied by fl [um] 40 37 c fl------output-R-Denominator to re, introduced to avoid problems in 41 38 c the averaging of the output. fl is the fraction of liquid 42 39 c water clouds within a grid cell 40 c 43 41 c pcltau--output-R-epaisseur optique des nuages 44 42 c pclemi--output-R-emissivite des nuages (0 a 1) 43 c pcldtaupi-output-R-pre-industrial value of cloud optical thickness, 44 c 45 c pcl-output-R-2D low-level cloud cover 46 c pcm-output-R-2D mid-level cloud cover 47 c pch-output-R-2D high-level cloud cover 48 c pct-output-R-2D total cloud cover 45 49 c====================================================================== 46 50 C 47 51 #include "YOMCST.h" 48 c49 cym#include "dimensions.h"50 cym#include "dimphy.h"51 52 #include "nuage.h" 52 cIM cf. CR: include pour NOVLP et ZEPSEC53 53 #include "radepsi.h" 54 54 #include "radopt.h" 55 55 56 c choix de l'hypothese de recouvrememnt nuageuse 56 LOGICAL RANDOM,MAXIMUM_RANDOM,MAXIMUM 57 parameter (RANDOM=.FALSE., MAXIMUM_RANDOM=.TRUE., MAXIMUM=.FALSE.) 57 LOGICAL RANDOM, MAXIMUM_RANDOM, MAXIMUM 58 PARAMETER (RANDOM=.FALSE., MAXIMUM_RANDOM=.TRUE., MAXIMUM=.FALSE.) 59 c 58 60 LOGICAL, SAVE :: FIRST=.TRUE. 59 61 !$OMP THREADPRIVATE(FIRST) 60 c Hypoyhese de recouvrement : MAXIMUM_RANDOM61 62 INTEGER flag_max 62 REAL phase3d(klon, klev),dh(klon, klev),pdel(klon, klev), 63 . zrho(klon, klev) 64 REAL tcc(klon), ftmp(klon), lcc_integrat(klon), height(klon) 63 c 64 c threshold PARAMETERs 65 65 REAL thres_tau,thres_neb 66 66 PARAMETER (thres_tau=0.3, thres_neb=0.001) 67 REAL t_tmp 68 REAL gravit69 PARAMETER (gravit=9.80616) !m/s270 REAL pqlwpcon(klon, klev), pqlwpstra(klon, klev) 71 c 72 REAL p aprs(klon,klev+1), pplay(klon,klev)67 c 68 REAL phase3d(klon, klev) 69 REAL tcc(klon), ftmp(klon), lcc_integrat(klon), height(klon) 70 c 71 REAL paprs(klon,klev+1) 72 REAL pplay(klon,klev) 73 73 REAL t(klon,klev) 74 c75 74 REAL pclc(klon,klev) 76 75 REAL pqlwp(klon,klev) 77 REAL pcltau(klon,klev), pclemi(klon,klev) 78 c 79 REAL pct(klon), pctlwp(klon), pch(klon), pcl(klon), pcm(klon) 76 REAL pcltau(klon,klev) 77 REAL pclemi(klon,klev) 78 REAL pcldtaupi(klon, klev) 79 c 80 REAL pct(klon) 81 REAL pcl(klon) 82 REAL pcm(klon) 83 REAL pch(klon) 84 REAL pctlwp(klon) 80 85 c 81 86 LOGICAL lo … … 85 90 ! PARAMETER (cetahb = 0.45, cetamb = 0.80) 86 91 ! Remplacer 87 ! cetahb*paprs(i,1) par prmhc88 ! cetamb*paprs(i,1) par prlmc89 REAL prmhc ! Pressure between medium and high level cloud 90 REAL prlmc ! Pressure between low and medium level cloud 92 ! cetahb*paprs(i,1) par prmhc 93 ! cetamb*paprs(i,1) par prlmc 94 REAL prmhc ! Pressure between medium and high level cloud in Pa 95 REAL prlmc ! Pressure between low and medium level cloud in Pa 91 96 PARAMETER (prmhc = 440.*100., prlmc = 680.*100.) 92 93 97 C 94 98 INTEGER i, k 95 cIM: 091003 REAL zflwp, zradef, zfice, zmsac96 REAL zflwp(klon), zradef, zfice, zmsac97 cIM: 091003 rajout98 99 REAL xflwp(klon), xfiwp(klon) 99 100 REAL xflwc(klon,klev), xfiwc(klon,klev) 100 101 c 101 REAL radius, rad_chaud 102 cc PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0) 103 ccc PARAMETER (rad_chaud=15.0, rad_froid=35.0) 104 c sintex initial PARAMETER (rad_chaud=10.0, rad_froid=30.0) 105 REAL coef, coef_froi, coef_chau 102 REAL radius 103 c 104 REAL coef_froi, coef_chau 106 105 PARAMETER (coef_chau=0.13, coef_froi=0.09) 106 c 107 107 REAL seuil_neb 108 108 PARAMETER (seuil_neb=0.001) 109 c 109 110 INTEGER nexpo ! exponentiel pour glace/eau 110 111 PARAMETER (nexpo=6) 111 ccc PARAMETER (nexpo=1) 112 113 c -- sb: 114 logical ok_newmicro 115 c parameter (ok_newmicro=.FALSE.) 116 cIM: 091003 real rel, tc, rei, zfiwp 117 real rel, tc, rei, zfiwp(klon) 118 real k_liq, k_ice0, k_ice, DF 119 parameter (k_liq=0.0903, k_ice0=0.005) ! units=m2/g 120 parameter (DF=1.66) ! diffusivity factor 121 c sb -- 112 c PARAMETER (nexpo=1) 113 114 REAL rel, tc, rei 115 REAL k_ice0, k_ice, DF 116 PARAMETER (k_ice0=0.005) ! units=m2/g 117 PARAMETER (DF=1.66) ! diffusivity factor 118 c 122 119 cjq for the aerosol indirect effect 123 120 cjq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003 124 121 cjq 125 LOGICAL ok_aie ! Apply AIE or not?126 LOGICAL ok_a1lwpdep ! a1 LWP dependent?127 128 122 REAL mass_solu_aero(klon, klev) ! total mass concentration for all soluble aerosols [ug m-3] 129 123 REAL mass_solu_aero_pi(klon, klev) ! - " - (pre-industrial value) … … 135 129 REAL fl(klon, klev) ! xliq * rneb (denominator to re; fraction of liquid water clouds within the grid cell) 136 130 131 LOGICAL ok_cdnc 137 132 REAL bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula 138 133 139 REAL cldtaupi(klon, klev) ! pre-industrial cloud opt thickness for diag140 134 cjq-end 141 135 cIM cf. CR:parametres supplementaires … … 145 139 REAL zcloudm(klon) 146 140 REAL zcloudl(klon) 147 148 149 c ************************** 150 c * * 151 c * DEBUT PARTIE OPTIMISEE * 152 c * * 153 c ************************** 154 155 REAL diff_paprs(klon, klev), zfice1, zfice2(klon, klev) 156 REAL rad_chaud_tab(klon, klev), zflwp_var, zfiwp_var 141 REAL rhodz(klon, klev) !--rho*dz pour la couche 142 REAL zrho(klon, klev) !--rho pour la couche 143 REAL dh(klon, klev) !--dz pour la couche 144 REAL zfice(klon, klev) 145 REAL rad_chaud(klon, klev) !--rayon pour les nuages chauds 146 REAL zflwp_var, zfiwp_var 157 147 REAL d_rei_dt 158 148 … … 171 161 ! Pour retrouver les résultats numériques de la version d'origine, 172 162 ! on impose 0.71 quand on est proche de 0.71 173 163 c 174 164 d_rei_dt=(rei_max-rei_min)/81.4 175 165 if (abs(d_rei_dt-0.71)<1.e-4) d_rei_dt=0.71 176 ! print*,'d_rei_dT ',d_rei_dt,rei_min,rei_max177 166 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 178 167 c 179 168 c Calculer l'epaisseur optique et l'emmissivite des nuages 180 c181 169 c IM inversion des DO 170 c 182 171 xflwp = 0.d0 183 172 xfiwp = 0.d0 184 173 xflwc = 0.d0 185 174 xfiwc = 0.d0 186 187 ! Initialisation 175 c 188 176 reliq=0. 189 177 reice=0. 190 178 c 191 179 DO k = 1, klev 192 DO i = 1, klon 193 diff_paprs(i,k) = (paprs(i,k)-paprs(i,k+1))/RG 180 DO i = 1, klon 181 c-layer calculation 182 rhodz(i,k) = (paprs(i,k)-paprs(i,k+1))/RG ! kg/m2 183 zrho(i,k)=pplay(i,k)/t(i,k)/RD ! kg/m3 184 dh(i,k)=rhodz(i,k)/zrho(i,k) ! m 185 c-Fraction of ice in cloud using a linear transition 186 zfice(i,k) = 1.0 - (t(i,k)-t_glace_min) / 187 & (t_glace_max-t_glace_min) 188 zfice(i,k) = MIN(MAX(zfice(i,k),0.0),1.0) 189 c-IM Total Liquid/Ice water content 190 xflwc(i,k) = (1.-zfice(i,k))*pqlwp(i,k) 191 xfiwc(i,k) = zfice(i,k)*pqlwp(i,k) 194 192 ENDDO 195 193 ENDDO 196 194 197 IF (ok_newmicro) THEN 198 199 200 DO k = 1, klev 201 DO i = 1, klon 202 c zfice2(i,k) = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace) 203 zfice2(i,k) = 1.0 - (t(i,k)-t_glace_min) / 204 & (t_glace_max-t_glace_min) 205 zfice2(i,k) = MIN(MAX(zfice2(i,k),0.0),1.0) 206 c IM Total Liquid/Ice water content 207 xflwc(i,k) = (1.-zfice2(i,k))*pqlwp(i,k) 208 xfiwc(i,k) = zfice2(i,k)*pqlwp(i,k) 209 c IM In-Cloud Liquid/Ice water content 210 c xflwc(i,k) = xflwc(i,k)+(1.-zfice)*pqlwp(i,k)/pclc(i,k) 211 c xfiwc(i,k) = xfiwc(i,k)+zfice*pqlwp(i,k)/pclc(i,k) 212 ENDDO 213 ENDDO 214 215 IF (ok_aie) THEN 216 DO k = 1, klev 217 DO i = 1, klon 218 ! Formula "D" of Boucher and Lohmann, Tellus, 1995 219 ! 220 cdnc(i,k) = 10.**(bl95_b0+bl95_b1* 195 IF (ok_cdnc) THEN 196 c 197 c--we compute cloud properties as a function of the aerosol load 198 c 199 DO k = 1, klev 200 DO i = 1, klon 201 c 202 c Formula "D" of Boucher and Lohmann, Tellus, 1995 203 c Cloud droplet number concentration (CDNC) is restricted 204 c to be within [20, 1000 cm^3] 205 c 206 c--present-day case 207 cdnc(i,k) = 10.**(bl95_b0+bl95_b1* 221 208 & log(MAX(mass_solu_aero(i,k),1.e-4))/log(10.))*1.e6 !-m-3 222 ! Cloud droplet number concentration (CDNC) is restricted 223 ! to be within [20, 1000 cm^3] 224 ! 225 cdnc(i,k)=MIN(1000.e6,MAX(20.e6,cdnc(i,k))) 226 ! 227 ! 228 cdnc_pi(i,k) = 10.**(bl95_b0+bl95_b1* 209 cdnc(i,k)=MIN(1000.e6,MAX(20.e6,cdnc(i,k))) 210 c 211 c--pre-industrial case 212 cdnc_pi(i,k) = 10.**(bl95_b0+bl95_b1* 229 213 & log(MAX(mass_solu_aero_pi(i,k),1.e-4))/log(10.)) 230 214 & *1.e6 !-m-3 231 cdnc_pi(i,k)=MIN(1000.e6,MAX(20.e6,cdnc_pi(i,k))) 232 ENDDO 233 ENDDO 234 DO k = 1, klev 235 DO i = 1, klon 236 ! rad_chaud_tab(i,k) = 237 ! & MAX(1.1e6 238 ! & *((pqlwp(i,k)*pplay(i,k)/(RD * T(i,k))) 239 ! & /(4./3*RPI*1000.*cdnc(i,k)) )**(1./3.),5.) 240 rad_chaud_tab(i,k) = 241 & 1.1 242 & *((pqlwp(i,k)*pplay(i,k)/(RD * T(i,k))) 243 & /(4./3*RPI*1000.*cdnc(i,k)) )**(1./3.) 244 rad_chaud_tab(i,k) = MAX(rad_chaud_tab(i,k) * 1e6, 5.) 245 ENDDO 246 ENDDO 247 ELSE 248 DO k = 1, MIN(3,klev) 249 DO i = 1, klon 250 rad_chaud_tab(i,k) = rad_chau2 251 ENDDO 252 ENDDO 253 DO k = MIN(3,klev)+1, klev 254 DO i = 1, klon 255 rad_chaud_tab(i,k) = rad_chau1 256 ENDDO 257 ENDDO 258 259 ENDIF 260 261 DO k = 1, klev 262 ! IF(.not.ok_aie) THEN 263 rad_chaud = rad_chau1 264 IF (k.LE.3) rad_chaud = rad_chau2 265 ! ENDIF 266 DO i = 1, klon 267 IF (pclc(i,k) .LE. seuil_neb) THEN 268 269 c -- effective cloud droplet radius (microns): 270 271 c for liquid water clouds: 272 ! For output diagnostics 273 ! 274 ! Cloud droplet effective radius [um] 275 ! 276 ! we multiply here with f * xl (fraction of liquid water 277 ! clouds in the grid cell) to avoid problems in the 278 ! averaging of the output. 279 ! In the output of IOIPSL, derive the real cloud droplet 280 ! effective radius as re/fl 281 ! 282 283 fl(i,k) = seuil_neb*(1.-zfice2(i,k)) 284 re(i,k) = rad_chaud_tab(i,k)*fl(i,k) 285 286 rel = 0. 287 rei = 0. 288 pclc(i,k) = 0.0 289 pcltau(i,k) = 0.0 290 pclemi(i,k) = 0.0 291 cldtaupi(i,k) = 0.0 292 ELSE 293 215 cdnc_pi(i,k)=MIN(1000.e6,MAX(20.e6,cdnc_pi(i,k))) 216 c 217 c--present-day case 218 rad_chaud(i,k) = 219 & 1.1*((pqlwp(i,k)*pplay(i,k)/(RD * T(i,k))) 220 & /(4./3*RPI*1000.*cdnc(i,k)) )**(1./3.) 221 rad_chaud(i,k) = MAX(rad_chaud(i,k) * 1.e6, 5.) 222 c 223 c--pre-industrial case 224 radius = 225 & 1.1*((pqlwp(i,k)*pplay(i,k)/(RD * T(i,k))) 226 & /(4./3.*RPI*1000.*cdnc_pi(i,k)))**(1./3.) 227 radius = MAX(radius*1.e6, 5.) 228 c 229 c--pre-industrial case 230 c--liquid/ice cloud water paths: 231 IF (pclc(i,k) .LE. seuil_neb) THEN 232 c 233 pcldtaupi(i,k) = 0.0 234 c 235 ELSE 236 c 237 zflwp_var= 1000.*(1.-zfice(i,k))*pqlwp(i,k)/pclc(i,k) 238 & *rhodz(i,k) 239 zfiwp_var= 1000.*zfice(i,k)*pqlwp(i,k)/pclc(i,k) 240 & *rhodz(i,k) 241 tc = t(i,k)-273.15 242 rei = d_rei_dt*tc + rei_max 243 if (tc.le.-81.4) rei = rei_min 244 c 245 c-- cloud optical thickness : 246 c [for liquid clouds, traditional formula, 247 c for ice clouds, Ebert & Curry (1992)] 248 c 249 if (zflwp_var.eq.0.) radius = 1. 250 if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1. 251 pcldtaupi(i,k) = 3.0/2.0 * zflwp_var / radius 252 & + zfiwp_var * (3.448e-03 + 2.431/rei) 253 c 254 ENDIF 255 c 256 ENDDO 257 ENDDO 258 c 259 ELSE !--not ok_cdnc 260 c 261 c-prescribed cloud droplet radius 262 c 263 DO k = 1, MIN(3,klev) 264 DO i = 1, klon 265 rad_chaud(i,k) = rad_chau2 266 ENDDO 267 ENDDO 268 DO k = MIN(3,klev)+1, klev 269 DO i = 1, klon 270 rad_chaud(i,k) = rad_chau1 271 ENDDO 272 ENDDO 273 274 ENDIF !--ok_cdnc 275 c 276 c--computation of cloud optical depth and emissivity 277 c--in the general case 278 c 279 DO k = 1, klev 280 DO i = 1, klon 281 c 282 IF (pclc(i,k) .LE. seuil_neb) THEN 283 c 284 c effective cloud droplet radius (microns) for liquid water clouds: 285 c For output diagnostics cloud droplet effective radius [um] 286 c we multiply here with f * xl (fraction of liquid water 287 c clouds in the grid cell) to avoid problems in the averaging of the output. 288 c In the output of IOIPSL, derive the REAL cloud droplet 289 c effective radius as re/fl 290 c 291 fl(i,k) = seuil_neb*(1.-zfice(i,k)) 292 re(i,k) = rad_chaud(i,k)*fl(i,k) 293 rel = 0. 294 rei = 0. 295 pclc(i,k) = 0.0 296 pcltau(i,k) = 0.0 297 pclemi(i,k) = 0.0 298 c 299 ELSE 300 c 294 301 c -- liquid/ice cloud water paths: 295 302 296 zflwp_var= 1000.*(1.-zfice2(i,k))*pqlwp(i,k)/pclc(i,k) 297 & *diff_paprs(i,k) 298 zfiwp_var= 1000.*zfice2(i,k)*pqlwp(i,k)/pclc(i,k) 299 & *diff_paprs(i,k) 300 301 c -- effective cloud droplet radius (microns): 302 303 c for liquid water clouds: 304 305 IF (ok_aie) THEN 306 radius = 307 & 1.1 308 & *((pqlwp(i,k)*pplay(i,k)/(RD * T(i,k))) 309 & /(4./3.*RPI*1000.*cdnc_pi(i,k)))**(1./3.) 310 radius = MAX(radius*1e6, 5.) 311 312 tc = t(i,k)-273.15 313 rei = d_rei_dt*tc + rei_max 314 if (tc.le.-81.4) rei = rei_min 315 if (zflwp_var.eq.0.) radius = 1. 316 if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1. 317 cldtaupi(i,k) = 3.0/2.0 * zflwp_var / radius 318 & + zfiwp_var * (3.448e-03 + 2.431/rei) 319 320 ENDIF ! ok_aie 321 ! For output diagnostics 322 ! 323 ! Cloud droplet effective radius [um] 324 ! 325 ! we multiply here with f * xl (fraction of liquid water 326 ! clouds in the grid cell) to avoid problems in the 327 ! averaging of the output. 328 ! In the output of IOIPSL, derive the real cloud droplet 329 ! effective radius as re/fl 330 ! 331 332 fl(i,k) = pclc(i,k)*(1.-zfice2(i,k)) 333 re(i,k) = rad_chaud_tab(i,k)*fl(i,k) 334 335 rel = rad_chaud_tab(i,k) 336 c for ice clouds: as a function of the ambiant temperature 337 c [formula used by Iacobellis and Somerville (2000), with an 338 c asymptotical value of 3.5 microns at T<-81.4 C added to be 339 c consistent with observations of Heymsfield et al. 1986]: 340 c 2011/05/24 : rei_min = 3.5 becomes a free parameter as well as rei_max=61.29 341 tc = t(i,k)-273.15 342 rei = d_rei_dt*tc + rei_max 343 if (tc.le.-81.4) rei = rei_min 344 c -- cloud optical thickness : 345 346 c [for liquid clouds, traditional formula, 347 c for ice clouds, Ebert & Curry (1992)] 348 303 zflwp_var= 1000.*(1.-zfice(i,k))*pqlwp(i,k)/pclc(i,k) 304 & *rhodz(i,k) 305 zfiwp_var= 1000.*zfice(i,k)*pqlwp(i,k)/pclc(i,k) 306 & *rhodz(i,k) 307 c 308 c effective cloud droplet radius (microns) for liquid water clouds: 309 c For output diagnostics cloud droplet effective radius [um] 310 c we multiply here with f * xl (fraction of liquid water 311 c clouds in the grid cell) to avoid problems in the averaging of the output. 312 c In the output of IOIPSL, derive the REAL cloud droplet 313 c effective radius as re/fl 314 c 315 fl(i,k) = pclc(i,k)*(1.-zfice(i,k)) 316 re(i,k) = rad_chaud(i,k)*fl(i,k) 317 c 318 rel = rad_chaud(i,k) 319 c 320 c for ice clouds: as a function of the ambiant temperature 321 c [formula used by Iacobellis and Somerville (2000), with an 322 c asymptotical value of 3.5 microns at T<-81.4 C added to be 323 c consistent with observations of Heymsfield et al. 1986]: 324 c 2011/05/24 : rei_min = 3.5 becomes a free PARAMETER as well as rei_max=61.29 325 c 326 tc = t(i,k)-273.15 327 rei = d_rei_dt*tc + rei_max 328 if (tc.le.-81.4) rei = rei_min 329 c 330 c-- cloud optical thickness : 331 c [for liquid clouds, traditional formula, 332 c for ice clouds, Ebert & Curry (1992)] 333 c 349 334 if (zflwp_var.eq.0.) rel = 1. 350 335 if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1. 351 336 pcltau(i,k) = 3.0/2.0 * ( zflwp_var/rel ) 352 337 & + zfiwp_var * (3.448e-03 + 2.431/rei) 338 c 353 339 c -- cloud infrared emissivity: 354 355 c [the broadband infrared absorption coefficient is parameterized 340 c [the broadband infrared absorption coefficient is PARAMETERized 356 341 c as a function of the effective cld droplet radius] 357 358 342 c Ebert and Curry (1992) formula as used by Kiehl & Zender (1995): 343 c 359 344 k_ice = k_ice0 + 1.0/rei 360 345 c 361 346 pclemi(i,k) = 1.0 362 347 & - EXP( -coef_chau*zflwp_var - DF*k_ice*zfiwp_var) 363 364 ENDIF 365 reliq(i,k)=rel 366 reice(i,k)=rei 367 ! if (i.eq.1) then 368 ! print*,'Dans newmicro rel, rei :',rel, rei 369 ! print*,'Dans newmicro reliq, reice :', 370 ! $ reliq(i,k),reice(i,k) 371 ! endif 372 373 ENDDO 374 ENDDO 375 348 c 349 ENDIF 350 c 351 reliq(i,k)=rel 352 reice(i,k)=rei 353 c 354 xflwp(i) = xflwp(i)+ xflwc(i,k) * rhodz(i,k) 355 xfiwp(i) = xfiwp(i)+ xfiwc(i,k) * rhodz(i,k) 356 c 357 ENDDO 358 ENDDO 359 c 360 c--if cloud droplet radius is fixed, then pcldtaupi=pcltau 361 c 362 IF (.NOT.ok_cdnc) THEN 376 363 DO k = 1, klev 377 364 DO i = 1, klon 378 xflwp(i) = xflwp(i)+ xflwc(i,k) * diff_paprs(i,k) 379 xfiwp(i) = xfiwp(i)+ xfiwc(i,k) * diff_paprs(i,k) 380 ENDDO 381 ENDDO 382 383 ELSE 384 DO k = 1, klev 385 rad_chaud = rad_chau1 386 IF (k.LE.3) rad_chaud = rad_chau2 387 DO i = 1, klon 388 389 IF (pclc(i,k) .LE. seuil_neb) THEN 390 391 pclc(i,k) = 0.0 392 pcltau(i,k) = 0.0 393 pclemi(i,k) = 0.0 394 cldtaupi(i,k) = 0.0 395 396 ELSE 397 398 zflwp_var = 1000.*pqlwp(i,k)*diff_paprs(i,k) 399 & /pclc(i,k) 400 401 zfice1 = MIN( 402 & MAX( 1.0 - (t(i,k)-t_glace_min) / 403 & (t_glace_max-t_glace_min),0.0),1.0)**nexpo 404 405 radius = rad_chaud * (1.-zfice1) + rad_froid * zfice1 406 coef = coef_chau * (1.-zfice1) + coef_froi * zfice1 407 408 pcltau(i,k) = 3.0 * zflwp_var / (2.0 * radius) 409 pclemi(i,k) = 1.0 - EXP( - coef * zflwp_var) 410 411 ENDIF 412 413 ENDDO 414 ENDDO 415 ENDIF 416 417 IF (.NOT.ok_aie) THEN 418 DO k = 1, klev 419 DO i = 1, klon 420 cldtaupi(i,k)=pcltau(i,k) 365 pcldtaupi(i,k)=pcltau(i,k) 421 366 ENDDO 422 367 ENDDO 423 368 ENDIF 424 425 ccc DO k = 1, klev426 ccc DO i = 1, klon427 ccc t(i,k) = t(i,k)428 ccc pclc(i,k) = MAX( 1.e-5 , pclc(i,k) )429 ccc lo = pclc(i,k) .GT. (2.*1.e-5)430 ccc zflwp = pqlwp(i,k)*1000.*(paprs(i,k)-paprs(i,k+1))431 ccc . /(rg*pclc(i,k))432 ccc zradef = 10.0 + (1.-sigs(k))*45.0433 ccc pcltau(i,k) = 1.5 * zflwp / zradef434 ccc zfice=1.0-MIN(MAX((t(i,k)-263.)/(273.-263.),0.0),1.0)435 ccc zmsac = 0.13*(1.0-zfice) + 0.08*zfice436 ccc pclemi(i,k) = 1.-EXP(-zmsac*zflwp)437 ccc if (.NOT.lo) pclc(i,k) = 0.0438 ccc if (.NOT.lo) pcltau(i,k) = 0.0439 ccc if (.NOT.lo) pclemi(i,k) = 0.0440 ccc ENDDO441 ccc ENDDO442 ccccc print*, 'pas de nuage dans le rayonnement'443 ccccc DO k = 1, klev444 ccccc DO i = 1, klon445 ccccc pclc(i,k) = 0.0446 ccccc pcltau(i,k) = 0.0447 ccccc pclemi(i,k) = 0.0448 ccccc ENDDO449 ccccc ENDDO450 369 C 451 370 C COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS 452 C453 371 c IM cf. CR:test: calcul prenant ou non en compte le recouvrement 454 372 c initialisations 373 c 455 374 DO i=1,klon 456 375 zclear(i)=1. … … 465 384 ENDDO 466 385 C 467 cIM cf CR DO k=1,klev 386 c--calculation of liquid water path 387 c 468 388 DO k = klev, 1, -1 469 389 DO i = 1, klon 470 pctlwp(i) = pctlwp(i) 471 & + pqlwp(i,k)*diff_paprs(i,k) 390 pctlwp(i) = pctlwp(i)+ pqlwp(i,k)*rhodz(i,k) 472 391 ENDDO 473 392 ENDDO 474 c IM cf. CR 393 c 394 c--calculation of cloud properties with cloud overlap 395 c 475 396 IF (NOVLP.EQ.1) THEN 476 397 DO k = klev, 1, -1 477 398 DO i = 1, klon 478 399 zclear(i)=zclear(i)*(1.-MAX(pclc(i,k),zcloud(i))) 479 & /(1.-MIN( real(zcloud(i), kind=8),1.-ZEPSEC))400 & /(1.-MIN(REAL(zcloud(i), kind=8),1.-ZEPSEC)) 480 401 pct(i)=1.-zclear(i) 481 402 IF (paprs(i,k).LT.prmhc) THEN 482 403 pch(i) = pch(i)*(1.-MAX(pclc(i,k),zcloudh(i))) 483 & /(1.-MIN( real(zcloudh(i), kind=8),1.-ZEPSEC))404 & /(1.-MIN(REAL(zcloudh(i), kind=8),1.-ZEPSEC)) 484 405 zcloudh(i)=pclc(i,k) 485 406 ELSE IF (paprs(i,k).GE.prmhc .AND. 486 407 & paprs(i,k).LT.prlmc) THEN 487 408 pcm(i) = pcm(i)*(1.-MAX(pclc(i,k),zcloudm(i))) 488 & /(1.-MIN( real(zcloudm(i), kind=8),1.-ZEPSEC))409 & /(1.-MIN(REAL(zcloudm(i), kind=8),1.-ZEPSEC)) 489 410 zcloudm(i)=pclc(i,k) 490 411 ELSE IF (paprs(i,k).GE.prlmc) THEN 491 412 pcl(i) = pcl(i)*(1.-MAX(pclc(i,k),zcloudl(i))) 492 & /(1.-MIN( real(zcloudl(i), kind=8),1.-ZEPSEC))413 & /(1.-MIN(REAL(zcloudl(i), kind=8),1.-ZEPSEC)) 493 414 zcloudl(i)=pclc(i,k) 494 415 endif … … 527 448 ENDDO 528 449 ENDIF 529 530 450 C 531 451 DO i = 1, klon 532 c IM cf. CR pct(i)=1.-pct(i)533 452 pch(i)=1.-pch(i) 534 453 pcm(i)=1.-pcm(i) 535 454 pcl(i)=1.-pcl(i) 536 455 ENDDO 537 456 c 538 457 c ======================================================== 539 !DIAGNOSTICS CALCULATION FOR CMIP5 PROTOCOL458 c DIAGNOSTICS CALCULATION FOR CMIP5 PROTOCOL 540 459 c ======================================================== 541 !! change by Nicolas Yan (LSCE) 542 !! Cloud Droplet Number Concentration (CDNC) : 3D variable 543 !! Fractionnal cover by liquid water cloud (LCC3D) : 3D variable 544 !! Cloud Droplet Number Concentration at top of cloud (CLDNCL) : 2D variable 545 !! Droplet effective radius at top of cloud (REFFCLWTOP) : 2D variable 546 !! Fractionnal cover by liquid water at top of clouds (LCC) : 2D variable 547 IF (ok_newmicro) THEN 548 IF (ok_aie) THEN 460 c change by Nicolas Yan (LSCE) 461 c Cloud Droplet Number Concentration (CDNC) : 3D variable 462 c Fractionnal cover by liquid water cloud (LCC3D) : 3D variable 463 c Cloud Droplet Number Concentration at top of cloud (CLDNCL) : 2D variable 464 c Droplet effective radius at top of cloud (REFFCLWTOP) : 2D variable 465 c Fractionnal cover by liquid water at top of clouds (LCC) : 2D variable 466 c 467 IF (ok_cdnc) THEN 468 c 549 469 DO k = 1, klev 550 470 DO i = 1, klon 551 phase3d(i,k)=1-zfice 2(i,k)471 phase3d(i,k)=1-zfice(i,k) 552 472 IF (pclc(i,k) .LE. seuil_neb) THEN 553 473 lcc3d(i,k)=seuil_neb*phase3d(i,k) … … 558 478 ENDDO 559 479 ENDDO 560 480 c 561 481 DO i=1,klon 562 482 lcc(i)=0. … … 566 486 IF(MAXIMUM) tcc(i) = 0. 567 487 ENDDO 568 569 488 c 570 489 DO i=1,klon 571 490 DO k=klev-1,1,-1 !From TOA down 572 573 491 c 574 492 ! Test, if the cloud optical depth exceeds the necessary 575 493 ! threshold: 576 494 577 IF (pcltau(i,k).GT.thres_tau .AND. pclc(i,k).GT.thres_neb) 578 . THEN 579 ! To calculate the right Temperature at cloud top, 580 ! interpolate it between layers: 581 t_tmp = t(i,k) + 582 . (paprs(i,k+1)-pplay(i,k))/(pplay(i,k+1)-pplay(i,k)) 583 . * ( t(i,k+1) - t(i,k) ) 584 585 IF(MAXIMUM) THEN 586 IF(FIRST) THEN 495 IF (pcltau(i,k).GT.thres_tau 496 . .AND. pclc(i,k).GT.thres_neb) THEN 497 498 IF (MAXIMUM) THEN 499 IF (FIRST) THEN 587 500 write(*,*)'Hypothese de recouvrement: MAXIMUM' 588 501 FIRST=.FALSE. … … 592 505 ENDIF 593 506 594 IF (RANDOM) THEN595 IF (FIRST) THEN507 IF (RANDOM) THEN 508 IF (FIRST) THEN 596 509 write(*,*)'Hypothese de recouvrement: RANDOM' 597 510 FIRST=.FALSE. … … 601 514 ENDIF 602 515 603 IF (MAXIMUM_RANDOM) THEN604 IF (FIRST) THEN516 IF (MAXIMUM_RANDOM) THEN 517 IF (FIRST) THEN 605 518 write(*,*)'Hypothese de recouvrement: MAXIMUM_ 606 519 . RANDOM' … … 613 526 ENDIF 614 527 c Effective radius of cloud droplet at top of cloud (m) 615 reffclwtop(i) = reffclwtop(i) + rad_chaud _tab(i,k) *528 reffclwtop(i) = reffclwtop(i) + rad_chaud(i,k) * 616 529 . 1.0E-06 * phase3d(i,k) * ( tcc(i) - ftmp(i))*flag_max 617 530 c CDNC at top of cloud (m-3) … … 626 539 ENDIF ! is there a visible, not-too-small cloud? 627 540 ENDDO ! loop over k 628 629 IF(RANDOM .OR. MAXIMUM_RANDOM) tcc(i)=1.-tcc(i) 541 c 542 IF (RANDOM .OR. MAXIMUM_RANDOM) tcc(i)=1.-tcc(i) 543 c 630 544 ENDDO ! loop over i 631 545 … … 633 547 DO i = 1, klon 634 548 DO k = 1, klev 635 pqlwpcon(i,k)=rnebcon(i,k)*clwcon(i,k) ! fraction eau liquide convective 636 pqlwpstra(i,k)=pclc(i,k)*phase3d(i,k)-pqlwpcon(i,k) ! fraction eau liquide stratiforme 637 IF (pqlwpstra(i,k) .LE. 0.0) pqlwpstra(i,k)=0.0 549 ! Weight to be used for outputs: eau_liquide*couverture nuageuse 550 lcc3dcon(i,k) =rnebcon(i,k)*phase3d(i,k)*clwcon(i,k) ! eau liquide convective 551 lcc3dstra(i,k)=pclc(i,k)*pqlwp(i,k)*phase3d(i,k) 552 lcc3dstra(i,k)=lcc3dstra(i,k)-lcc3dcon(i,k) ! eau liquide stratiforme 553 lcc3dstra(i,k)=MAX(lcc3dstra(i,k),0.0) 554 ! Compute cloud droplet radius as above in meter 555 radius=1.1*((pqlwp(i,k)*pplay(i,k)/(RD * T(i,k))) 556 & /(4./3*RPI*1000.*cdnc(i,k)) )**(1./3.) 557 radius=MAX(radius, 5.e-6) 638 558 ! Convective Cloud Droplet Effective Radius (REFFCLWC) : variable 3D 639 reffclwc(i,k)=1.1 640 & *((pqlwpcon(i,k)*pplay(i,k)/(RD * T(i,k))) 641 & /(4./3*RPI*1000.*cdnc(i,k)) )**(1./3.) 642 reffclwc(i,k) = MAX(reffclwc(i,k) * 1e6, 5.) 643 559 reffclwc(i,k)=radius 560 reffclwc(i,k)=reffclwc(i,k)*lcc3dcon(i,k) 644 561 ! Stratiform Cloud Droplet Effective Radius (REFFCLWS) : variable 3D 645 IF ((pclc(i,k)-rnebcon(i,k)) .LE. seuil_neb) THEN ! tout sous la forme convective 646 reffclws(i,k)=0.0 647 lcc3dstra(i,k)= 0.0 648 ELSE 649 reffclws(i,k) = (pclc(i,k)*phase3d(i,k)* 650 & rad_chaud_tab(i,k)- 651 & pqlwpcon(i,k)*reffclwc(i,k)) 652 IF(reffclws(i,k) .LE. 0.0) reffclws(i,k)=0.0 653 lcc3dstra(i,k)=pqlwpstra(i,k) 654 ENDIF 655 !Convertion from um to m 656 IF(rnebcon(i,k). LE. seuil_neb) THEN 657 reffclwc(i,k) = reffclwc(i,k)*seuil_neb*clwcon(i,k) 658 & *1.0E-06 659 lcc3dcon(i,k)= seuil_neb*clwcon(i,k) 660 ELSE 661 reffclwc(i,k) = reffclwc(i,k)*pqlwpcon(i,k) 662 & *1.0E-06 663 lcc3dcon(i,k) = pqlwpcon(i,k) 664 ENDIF 665 666 reffclws(i,k) = reffclws(i,k)*1.0E-06 667 562 reffclws(i,k)=radius 563 reffclws(i,k)=reffclws(i,k)*lcc3dstra(i,k) 668 564 ENDDO !klev 669 565 ENDDO !klon 670 671 !! Column Integrated Cloud Droplet Number (CLDNVI) : variable 2D 672 DO k = 1, klev 673 DO i = 1, klon 674 pdel(i,k) = paprs(i,k)-paprs(i,k+1) 675 zrho(i,k)=pplay(i,k)/t(i,k)/RD ! kg/m3 676 dh(i,k)=pdel(i,k)/(gravit*zrho(i,k)) ! hauteur de chaque boite (m) 677 ENDDO 678 ENDDO 566 c 567 c Column Integrated Cloud Droplet Number (CLDNVI) : variable 2D 679 568 c 680 569 DO i = 1, klon … … 697 586 DO i = 1, klon 698 587 DO k = 1, klev 699 IF (scdnc(i,k) .LE. 0.0) scdnc(i,k)=0.0700 IF (reffclws(i,k) .LE. 0.0) reffclws(i,k)=0.0701 IF (reffclwc(i,k) .LE. 0.0) reffclwc(i,k)=0.0702 IF (lcc3d(i,k) .LE. 0.0) lcc3d(i,k)=0.0703 IF (lcc3dcon(i,k) .LE. 0.0) lcc3dcon(i,k)=0.0588 IF (scdnc(i,k) .LE. 0.0) scdnc(i,k)=0.0 589 IF (reffclws(i,k) .LE. 0.0) reffclws(i,k)=0.0 590 IF (reffclwc(i,k) .LE. 0.0) reffclwc(i,k)=0.0 591 IF (lcc3d(i,k) .LE. 0.0) lcc3d(i,k)=0.0 592 IF (lcc3dcon(i,k) .LE. 0.0) lcc3dcon(i,k)=0.0 704 593 IF (lcc3dstra(i,k) .LE. 0.0) lcc3dstra(i,k)=0.0 705 594 ENDDO 706 IF (reffclwtop(i) .LE. 0.0) reffclwtop(i)=0.0707 IF (cldncl(i) .LE. 0.0) cldncl(i)=0.0708 IF (cldnvi(i) .LE. 0.0) cldnvi(i)=0.0709 IF (lcc(i) .LE. 0.0) lcc(i)=0.0595 IF (reffclwtop(i) .LE. 0.0) reffclwtop(i)=0.0 596 IF (cldncl(i) .LE. 0.0) cldncl(i)=0.0 597 IF (cldnvi(i) .LE. 0.0) cldnvi(i)=0.0 598 IF (lcc(i) .LE. 0.0) lcc(i)=0.0 710 599 ENDDO 711 712 ENDIF !ok_aie 713 ENDIF !ok newmicro 714 c 715 C 600 c 601 ENDIF !ok_cdnc 602 c 716 603 RETURN 604 c 717 605 END -
LMDZ5/branches/testing/libf/phylmd/orografi_strato.F
r1492 r1750 2004 2004 2005 2005 DO 110 JK=1,NLEV 2006 ZPM1R=pplay_glo(klon_glo/2 ,jk)/paprs_glo(klon_glo/2+1,1)2006 ZPM1R=pplay_glo(klon_glo/2+1,jk)/paprs_glo(klon_glo/2+1,1) 2007 2007 IF(ZPM1R.GE.ZSIGT)THEN 2008 2008 nktopg=JK 2009 2009 ENDIF 2010 ZPM1R=pplay_glo(klon_glo/2 ,jk)/paprs_glo(klon_glo/2+1,1)2010 ZPM1R=pplay_glo(klon_glo/2+1,jk)/paprs_glo(klon_glo/2+1,1) 2011 2011 IF(ZPM1R.GE.ZTOP)THEN 2012 2012 nstra=JK -
LMDZ5/branches/testing/libf/phylmd/phys_local_var_mod.F90
r1539 r1750 24 24 REAL, SAVE, ALLOCATABLE :: d_u_dyn(:,:), d_v_dyn(:,:) 25 25 !$OMP THREADPRIVATE(d_u_dyn, d_v_dyn) 26 !!!! 27 REAL, SAVE, ALLOCATABLE :: d_tr_dyn(:,:,:) 28 !$OMP THREADPRIVATE(d_tr_dyn) 29 !!!! 26 30 REAL, SAVE, ALLOCATABLE :: d_t_con(:,:),d_q_con(:,:) 27 31 !$OMP THREADPRIVATE(d_t_con,d_q_con) … … 199 203 allocate(d_t_dyn(klon,klev),d_q_dyn(klon,klev)) 200 204 allocate(d_u_dyn(klon,klev),d_v_dyn(klon,klev)) 205 allocate(d_tr_dyn(klon,klev,nbtr)) !RomP 201 206 allocate(d_t_con(klon,klev),d_q_con(klon,klev)) 202 207 allocate(d_u_con(klon,klev),d_v_con(klon,klev)) … … 287 292 deallocate(d_t_dyn,d_q_dyn) 288 293 deallocate(d_u_dyn,d_v_dyn) 294 deallocate(d_tr_dyn) !RomP 289 295 deallocate(d_t_con,d_q_con) 290 296 deallocate(d_u_con,d_v_con) -
LMDZ5/branches/testing/libf/phylmd/phys_output_mod.F90
r1707 r1750 190 190 ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'tsol_sic') /) 191 191 192 type(ctrl_out),save,dimension(4) :: o_evappot_srf = (/ ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'evappot_ter'), & 193 ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'evappot_lic'), & 194 ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'evappot_oce'), & 195 ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'evappot_sic') /) 196 192 197 type(ctrl_out),save,dimension(4) :: o_sens_srf = (/ ctrl_out((/ 1, 6, 10, 7, 10, 10 /),'sens_ter'), & 193 198 ctrl_out((/ 1, 6, 10, 7, 10, 10 /),'sens_lic'), & … … 475 480 type(ctrl_out),save :: o_rneb = ctrl_out((/ 2, 5, 10, 10, 10, 10 /),'rneb') 476 481 type(ctrl_out),save :: o_rnebcon = ctrl_out((/ 2, 5, 10, 10, 10, 10 /),'rnebcon') 482 type(ctrl_out),save :: o_rnebls = ctrl_out((/ 2, 5, 10, 10, 10, 10 /),'rnebls') 477 483 type(ctrl_out),save :: o_rhum = ctrl_out((/ 2, 5, 10, 10, 10, 10 /),'rhum') 478 484 type(ctrl_out),save :: o_ozone = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'ozone') … … 534 540 type(ctrl_out),save :: o_wake_deltaq = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'wake_deltaq') 535 541 type(ctrl_out),save :: o_wake_omg = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'wake_omg') 542 type(ctrl_out),save :: o_wdtrainA = ctrl_out((/ 4, 1, 10, 4, 1, 10 /),'wdtrainA') !<<RomP 543 type(ctrl_out),save :: o_wdtrainM = ctrl_out((/ 4, 1, 10, 4, 1, 10 /),'wdtrainM') !<<RomP 536 544 type(ctrl_out),save :: o_Vprecip = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'Vprecip') 537 545 type(ctrl_out),save :: o_ftd = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'ftd') … … 540 548 type(ctrl_out),save :: o_dtlschr = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtlschr') 541 549 type(ctrl_out),save :: o_dqlsc = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dqlsc') 550 type(ctrl_out),save :: o_beta_prec = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'beta_prec') 542 551 type(ctrl_out),save :: o_dtvdf = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtvdf') 543 552 type(ctrl_out),save :: o_dqvdf = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dqvdf') … … 653 662 USE infotrac 654 663 USE ioipsl 655 !USE phys_cal_mod, only : hour664 USE phys_cal_mod, only : hour 656 665 USE mod_phys_lmdz_para 657 666 USE aero_mod, only : naero_spc,name_aero … … 840 849 841 850 idayref = day_ref 842 CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) 851 ! CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) 852 ! correction pour l heure initiale !jyg 853 ! !jyg 854 CALL ymds2ju(annee_ref, 1, idayref, hour, zjulian) !jyg 855 ! correction pour l heure initiale !jyg 856 ! !jyg 857 !!! CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) !jyg 843 858 ! correction pour l heure initiale !jyg 844 859 ! !jyg … … 1042 1057 o_tsol_srf(nsrf)%flag,o_tsol_srf(nsrf)%name,"Temperature "//clnsurf(nsrf),"K") 1043 1058 CALL histdef2d(iff,clef_stations(iff), & 1059 o_evappot_srf(nsrf)%flag,o_evappot_srf(nsrf)%name,"Temperature"//clnsurf(nsrf),"K") 1060 CALL histdef2d(iff,clef_stations(iff), & 1044 1061 o_ustar_srf(nsrf)%flag,o_ustar_srf(nsrf)%name,"Friction velocity "//clnsurf(nsrf),"m/s") 1045 1062 CALL histdef2d(iff,clef_stations(iff), & … … 1455 1472 o_rnebcon%flag,o_rnebcon%name, "Convective Cloud Fraction", "-") 1456 1473 CALL histdef3d(iff,clef_stations(iff), & 1474 o_rnebls%flag,o_rnebls%name, "LS Cloud fraction", "-") 1475 CALL histdef3d(iff,clef_stations(iff), & 1457 1476 o_rhum%flag,o_rhum%name, "Relative humidity", "-") 1458 1477 CALL histdef3d(iff,clef_stations(iff), & … … 1560 1579 CALL histdef3d(iff,clef_stations(iff),o_wake_omg%flag,o_wake_omg%name, "wake_omg", " ") 1561 1580 ENDIF 1562 CALL histdef3d(iff,clef_stations(iff),o_Vprecip%flag,o_Vprecip%name, "precipitation vertical profile", "-")1581 !!! RomP CALL histdef3d(iff,clef_stations(iff),o_Vprecip%flag,o_Vprecip%name, "precipitation vertical profile", "-") 1563 1582 CALL histdef3d(iff,clef_stations(iff),o_ftd%flag,o_ftd%name, "tend temp due aux descentes precip", "-") 1564 1583 CALL histdef3d(iff,clef_stations(iff),o_fqd%flag,o_fqd%name,"tend vap eau due aux descentes precip", "-") 1565 1584 ENDIF !(iflag_con.EQ.3) 1585 1586 IF(iflag_con.GE.3) THEN ! RomP >>> 1587 CALL histdef3d(iff,clef_stations(iff),o_wdtrainA%flag,o_wdtrainA%name, "precipitation from AA", "-") 1588 CALL histdef3d(iff,clef_stations(iff),o_wdtrainM%flag,o_wdtrainM%name, "precipitation from mixture", "-") 1589 CALL histdef3d(iff,clef_stations(iff),o_Vprecip%flag,o_Vprecip%name, "precipitation vertical profile", "-") 1590 ENDIF !(iflag_con.GE.3) ! <<< RomP 1566 1591 1567 1592 !!! nrlmd le 10/04/2012 … … 1590 1615 CALL histdef3d(iff,clef_stations(iff),o_dtlschr%flag,o_dtlschr%name,"Large-scale condensational heating rate","K/s") 1591 1616 CALL histdef3d(iff,clef_stations(iff),o_dqlsc%flag,o_dqlsc%name, "Condensation dQ", "(kg/kg)/s") 1617 CALL histdef3d(iff,clef_stations(iff),o_beta_prec%flag,o_beta_prec%name, "LS Conversion rate to prec", "(kg/kg)/s") 1592 1618 CALL histdef3d(iff,clef_stations(iff),o_dtvdf%flag,o_dtvdf%name, "Boundary-layer dT", "K/s") 1593 1619 CALL histdef3d(iff,clef_stations(iff),o_dqvdf%flag,o_dqvdf%name, "Boundary-layer dQ", "(kg/kg)/s") -
LMDZ5/branches/testing/libf/phylmd/phys_output_write.h
r1707 r1750 443 443 ENDIF 444 444 445 IF (o_evappot_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN 446 zx_tmp_fi2d(1 : klon) = evap_pot( 1 : klon, nsrf) 447 CALL histwrite_phy(nid_files(iff),clef_stations(iff), 448 $ o_evappot_srf(nsrf)%name,itau_w, 449 $ zx_tmp_fi2d) 450 ENDIF 451 445 452 IF (o_ustar_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN 446 453 zx_tmp_fi2d(1 : klon) = ustar(1 : klon, nsrf) … … 909 916 $o_fqd%name,itau_w,fqd) 910 917 ENDIF 911 ENDIF !(iflag_con.EQ.3) 918 919 ELSEIF (iflag_con.EQ.30) THEN 920 ! sortie RomP convection descente insaturee iflag_con=30 921 IF (o_Vprecip%flag(iff)<=lev_files(iff)) THEN 922 CALL histwrite_phy(nid_files(iff),clef_stations(iff), 923 $o_Vprecip%name,itau_w,Vprecip) 924 ENDIF 925 IF (o_wdtrainA%flag(iff)<=lev_files(iff)) THEN 926 CALL histwrite_phy(nid_files(iff),clef_stations(iff), 927 $o_wdtrainA%name,itau_w,wdtrainA) 928 ENDIF 929 IF (o_wdtrainM%flag(iff)<=lev_files(iff)) THEN 930 CALL histwrite_phy(nid_files(iff),clef_stations(iff), 931 $o_wdtrainM%name,itau_w,wdtrainM) 932 ENDIF 933 934 ENDIF !(iflag_con.EQ.3.or.iflag_con.EQ.30) 912 935 913 936 !!! nrlmd le 10/04/2012 … … 1582 1605 ENDIF 1583 1606 1607 IF (o_rnebls%flag(iff)<=lev_files(iff)) THEN 1608 CALL histwrite_phy(nid_files(iff),clef_stations(iff), 1609 $o_rnebls%name,itau_w,rneb) 1610 ENDIF 1611 1584 1612 IF (o_rhum%flag(iff)<=lev_files(iff)) THEN 1585 1613 CALL histwrite_phy(nid_files(iff),clef_stations(iff), … … 1776 1804 CALL histwrite_phy(nid_files(iff),clef_stations(iff), 1777 1805 $o_dqlsc%name,itau_w,zx_tmp_fi3d) 1806 ENDIF 1807 1808 IF (o_beta_prec%flag(iff)<=lev_files(iff)) THEN 1809 zx_tmp_fi3d(1:klon,1:klev)=beta_prec(1:klon,1:klev) 1810 CALL histwrite_phy(nid_files(iff),clef_stations(iff), 1811 $o_beta_prec%name,itau_w,zx_tmp_fi3d) 1778 1812 ENDIF 1779 1813 -
LMDZ5/branches/testing/libf/phylmd/phys_state_var_mod.F90
r1707 r1750 52 52 REAL, ALLOCATABLE, SAVE :: u_ancien(:,:), v_ancien(:,:) 53 53 !$OMP THREADPRIVATE(u_ancien, v_ancien) 54 !!! RomP >>> 55 REAL, ALLOCATABLE, SAVE :: tr_ancien(:,:,:) 56 !$OMP THREADPRIVATE(tr_ancien) 57 !!! RomP <<< 54 58 LOGICAL, SAVE :: ancien_ok 55 59 !$OMP THREADPRIVATE(ancien_ok) … … 358 362 USE control_mod 359 363 use aero_mod 364 use infotrac, ONLY : nbtr 360 365 IMPLICIT NONE 361 366 … … 384 389 ALLOCATE(t_ancien(klon,klev), q_ancien(klon,klev)) 385 390 ALLOCATE(u_ancien(klon,klev), v_ancien(klon,klev)) 391 !!! Rom P >>> 392 ALLOCATE(tr_ancien(klon,klev,nbtr)) 393 !!! Rom P <<< 386 394 ALLOCATE(clwcon(klon,klev),rnebcon(klon,klev)) 387 395 ALLOCATE(ratqs(klon,klev)) … … 521 529 deallocate(rugoro, t_ancien, q_ancien, clwcon, rnebcon) 522 530 deallocate( u_ancien, v_ancien ) 531 deallocate( tr_ancien) !RomP 523 532 deallocate(ratqs, pbl_tke) 524 533 deallocate(zmax0, f0) -
LMDZ5/branches/testing/libf/phylmd/physiq.F
r1707 r1750 227 227 REAL d_qx(klon,klev,nqtot) 228 228 REAL d_ps(klon) 229 ! Variables pour le transport convectif 229 230 real da(klon,klev),phi(klon,klev,klev),mp(klon,klev) 231 ! Variables pour le lessivage convectif 232 ! RomP >>> 233 real phi2(klon,klev,klev) 234 real d1a(klon,klev),dam(klon,klev) 235 real ev(klon,klev),ep(klon,klev) 236 real clw(klon,klev),elij(klon,klev,klev) 237 real epmlmMm(klon,klev,klev),eplaMm(klon,klev) 238 real wdtrainA(klon,klev),wdtrainM(klon,klev) 239 ! RomP <<< 230 240 !IM definition dynamique o_trac dans phys_output_open 231 241 ! type(ctrl_out) :: o_trac(nqtot) … … 285 295 REAL flwp_s(klon), fiwp_s(klon) 286 296 REAL flwc_s(klon,klev), fiwc_s(klon,klev) 297 298 REAL evap_pot(klon,nbsrf) 287 299 288 300 cIM ISCCP simulator v3.4 … … 544 556 c================================================================================================= 545 557 cCR04.12.07: on ajoute les nouvelles variables du nouveau schema de convection avec poches froides 546 c Variables li ées àla poche froide (jyg)558 c Variables li\'ees \`a la poche froide (jyg) 547 559 548 560 REAL mip(klon,klev) ! mass flux shed by the adiab ascent at each level … … 577 589 578 590 cRC 579 c Variables li ées àla poche froide (jyg et rr)580 c Version diagnostique pour l'instant : pas de r étroaction sur la convection591 c Variables li\'ees \`a la poche froide (jyg et rr) 592 c Version diagnostique pour l'instant : pas de r\'etroaction sur la convection 581 593 582 594 REAL t_wake(klon,klev),q_wake(klon,klev) ! wake pour la convection … … 638 650 639 651 c--------Stochastic Boundary Layer Triggering: ALE_BL-------- 640 c---Propri étés du thermiques au LCL641 real zlcl_th(klon) ! Altitude du LCL calcul écontinument (pcon dans thermcell_main.F90)652 c---Propri\'et\'es du thermiques au LCL 653 real zlcl_th(klon) ! Altitude du LCL calcul\'e continument (pcon dans thermcell_main.F90) 642 654 real fraca0(klon) ! Fraction des thermiques au LCL 643 655 real w0(klon) ! Vitesse des thermiques au LCL 644 real w_conv(klon) ! Vitesse verticale de grande échelle au LCL656 real w_conv(klon) ! Vitesse verticale de grande \'echelle au LCL 645 657 real therm_tke_max0(klon) ! TKE dans les thermiques au LCL 646 658 real env_tke_max0(klon) ! TKE dans l'environnement au LCL … … 650 662 real ale_bl_stat(klon) 651 663 652 c---D éclenchement stochastique664 c---D\'eclenchement stochastique 653 665 integer :: tau_trig(klon) 654 666 real proba_notrig(klon) … … 662 674 663 675 c---Fermeture statistique 664 real alp_bl_det(klon) ! ALP d éterministe du thermique unique665 real alp_bl_fluct_m(klon) ! ALP li ée aux fluctuations de flux de masse sous-nuageux666 real alp_bl_fluct_tke(klon) ! ALP li ée aux fluctuations d'énergie cinétique sous-nuageuse667 real alp_bl_conv(klon) ! ALP li ée à grande échelle676 real alp_bl_det(klon) ! ALP d\'terministe du thermique unique 677 real alp_bl_fluct_m(klon) ! ALP li\'ee aux fluctuations de flux de masse sous-nuageux 678 real alp_bl_fluct_tke(klon) ! ALP li\'ee aux fluctuations d'\'energie cin\'etique sous-nuageuse 679 real alp_bl_conv(klon) ! ALP li\'ee \`a grande \'echelle 668 680 real alp_bl_stat(klon) ! ALP totale 669 681 … … 695 707 REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction) 696 708 REAL frac_nucl(klon,klev) ! idem (nucleation) 709 ! RomP >>> 710 REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt) 711 REAL beta_prec(klon,klev) ! taux de conv de l'eau cond (utilise) 712 ! RomP <<< 697 713 INTEGER :: iii 698 714 REAL :: calday … … 1094 1110 ! Parameters 1095 1111 LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not 1112 LOGICAL ok_cdnc ! ok cloud droplet number concentration (O. Boucher 01-2013) 1096 1113 REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995) 1097 SAVE ok_ade, ok_aie, bl95_b0, bl95_b11098 c$OMP THREADPRIVATE(ok_ade, ok_aie, bl95_b0, bl95_b1)1114 SAVE ok_ade, ok_aie, ok_cdnc, bl95_b0, bl95_b1 1115 c$OMP THREADPRIVATE(ok_ade, ok_aie, ok_cdnc, bl95_b0, bl95_b1) 1099 1116 LOGICAL, SAVE :: aerosol_couple ! true : calcul des aerosols dans INCA 1100 1117 ! false : lecture des aerosol dans un fichier … … 1184 1201 c$OMP THREADPRIVATE(mskocean_beta) 1185 1202 REAL, dimension(klon, klev) :: beta ! facteur sur cldtaurad et cldemirad pour evaluer les retros liees aux CRF 1186 REAL, dimension(klon, klev) :: cldtaurad ! epaisseur optique pour radlwsw,COSP 1187 REAL, dimension(klon, klev) :: cldtaupirad ! epaisseur optique pour radlwsw,COSP cas pre-industrial 1188 REAL, dimension(klon, klev) :: cldemirad ! emissivite pour radlwsw,COSP 1203 REAL, dimension(klon, klev) :: cldtaurad ! epaisseur optique pour radlwsw pour tester "CRF off" 1204 REAL, dimension(klon, klev) :: cldtaupirad ! epaisseur optique pour radlwsw pour tester "CRF off" 1205 REAL, dimension(klon, klev) :: cldemirad ! emissivite pour radlwsw pour tester "CRF off" 1206 REAL, dimension(klon, klev) :: cldfrarad ! fraction nuageuse 1207 1189 1208 INTEGER :: nbtr_tmp ! Number of tracer inside concvl 1190 1209 REAL, dimension(klon,klev) :: sh_in ! Specific humidity entering in phytrac … … 1251 1270 . fact_cldcon, facttemps,ok_newmicro,iflag_radia, 1252 1271 . iflag_cldcon,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, 1253 . ok_ade, ok_aie, aerosol_couple,1272 . ok_ade, ok_aie, ok_cdnc, aerosol_couple, 1254 1273 . flag_aerosol, new_aod, 1255 1274 . bl95_b0, bl95_b1, … … 1358 1377 1359 1378 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1360 !! Un petit travail àfaire ici.1379 !! Un petit travail \`a faire ici. 1361 1380 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1362 1381 … … 1508 1527 ALLOCATE(iGCM(0), jGCM(0)) 1509 1528 end if 1510 ENDIF !debut 1529 else 1530 ALLOCATE(tabijGCM(0)) 1531 ALLOCATE(lonGCM(0), latGCM(0)) 1532 ALLOCATE(iGCM(0), jGCM(0)) 1533 ENDIF 1511 1534 1512 1535 DO i=1,klon … … 1521 1544 ! justement quand ok_orodr = false. 1522 1545 ! ce rugoro est utilise par la couche limite et fait double emploi 1523 ! avec les param étrisations spécifiques de Francois Lott.1546 ! avec les param\'etrisations sp\'ecifiques de Francois Lott. 1524 1547 ! DO i=1,klon 1525 1548 ! rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0) … … 1738 1761 mp(:,:)=0. 1739 1762 phi(:,:,:)=0. 1763 ! RomP >>> 1764 phi2(:,:,:)=0. 1765 beta_prec_fisrt(:,:)=0. 1766 beta_prec(:,:)=0. 1767 epmlmMm(:,:,:)=0. 1768 eplaMm(:,:)=0. 1769 d1a(:,:)=0. 1770 dam(:,:)=0. 1771 ! RomP <<< 1772 1740 1773 c 1741 1774 c Ne pas affecter les valeurs entrees de u, v, h, et q … … 1803 1836 ENDDO 1804 1837 ENDDO 1838 !!! RomP >>> td dyn traceur 1839 IF (nqtot.GE.3) THEN 1840 DO iq = 3, nqtot 1841 DO k = 1, klev 1842 DO i = 1, klon 1843 d_tr_dyn(i,k,iq-2)= 1844 $ (tr_seri(i,k,iq-2)-tr_ancien(i,k,iq-2))/dtime 1845 ! iiq=niadv(iq) 1846 ! print*,i,k," d_tr_dyn",d_tr_dyn(i,k,iq-2),"tra:",iq,tname(iiq) 1847 ENDDO 1848 ENDDO 1849 ENDDO 1850 ENDIF 1851 !!! RomP <<< 1805 1852 ELSE 1806 1853 DO k = 1, klev … … 1812 1859 ENDDO 1813 1860 ENDDO 1861 !!! RomP >>> td dyn traceur 1862 IF (nqtot.GE.3) THEN 1863 DO iq = 3, nqtot 1864 DO k = 1, klev 1865 DO i = 1, klon 1866 d_tr_dyn(i,k,iq-2)= 0.0 1867 ENDDO 1868 ENDDO 1869 ENDDO 1870 ENDIF 1871 !!! RomP <<< 1814 1872 ancien_ok = .TRUE. 1815 1873 ENDIF … … 1927 1985 ! Calculs de l'orbite. 1928 1986 ! Necessaires pour le rayonnement et la surface (calcul de l'albedo). 1929 ! doit donc etre plac éavant radlwsw et pbl_surface1987 ! doit donc etre plac\'e avant radlwsw et pbl_surface 1930 1988 1931 1989 !!! jyg 17 Sep 2010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 1956 2014 ! Pour une solarlong0=1000., on calcule un ensoleillement moyen sur 1957 2015 ! l'annee a partir d'une formule analytique. 1958 ! Cet ensoleillement est sym métrique autour de l'équateur et2016 ! Cet ensoleillement est sym\'etrique autour de l'\'equateur et 1959 2017 ! non nul aux poles. 1960 2018 IF (abs(solarlong0-1000.)<1.e-4) then … … 1996 2054 c dsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq 1997 2055 c 2056 2057 c Calcul de l'humidite de saturation au niveau du sol 2058 2059 1998 2060 1999 2061 if (iflag_pbl/=0) then … … 2035 2097 call writefield_phy('q_seri',q_seri,llm) 2036 2098 endif 2099 2100 CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, 2101 e t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),evap_pot) 2037 2102 2038 2103 … … 2220 2285 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2221 2286 ! Modif FH 2010/04/27. Sans doute temporaire. 2222 ! Deux options pour le alp_offset : constant si > à 0 ou proportionnel Ãa2287 ! Deux options pour le alp_offset : constant si >?? 0 ou proportionnel ??a 2223 2288 ! w si <0 2224 2289 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 2284 2349 . Ma,mip,Vprecip,cape,cin,tvp,Tconv,iflagctrl, 2285 2350 . pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd, 2286 . pmflxr,pmflxs,da,phi,mp, 2287 . ftd,fqd,lalim_conv,wght_th) 2351 ! RomP >>> 2352 !! . pmflxr,pmflxs,da,phi,mp, 2353 !! . ftd,fqd,lalim_conv,wght_th) 2354 . pmflxr,pmflxs,da,phi,mp,phi2,d1a,dam,sij,clw,elij, 2355 . ftd,fqd,lalim_conv,wght_th, 2356 . ev, ep,epmlmMm,eplaMm, 2357 . wdtrainA,wdtrainM) 2358 ! RomP <<< 2288 2359 2289 2360 cIM begin … … 2616 2687 ENDIF 2617 2688 2618 c----Tirage al éatoire et calcul de ale_bl_trig2689 c----Tirage al\'eatoire et calcul de ale_bl_trig 2619 2690 do i=1,klon 2620 2691 if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) ) then … … 2663 2734 ! Transport de la TKE par les panaches thermiques. 2664 2735 ! FH : 2010/02/01 2665 2666 2667 2668 2736 ! if (iflag_pbl.eq.10) then 2737 ! call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm, 2738 ! s rg,paprs,pbl_tke) 2739 ! endif 2669 2740 ! ---------------------------------------------------------------------- 2670 2741 !IM/FH: 2011/02/23 … … 2689 2760 c ============== 2690 2761 2691 ! Dans le cas o ùon active les thermiques, on fait partir l'ajustement2762 ! Dans le cas o\`u on active les thermiques, on fait partir l'ajustement 2692 2763 ! a partir du sommet des thermiques. 2693 2764 ! Dans le cas contraire, on demarre au niveau 1. … … 2767 2838 . rain_lsc, snow_lsc, 2768 2839 . pfrac_impa, pfrac_nucl, pfrac_1nucl, 2769 . frac_impa, frac_nucl, 2840 . frac_impa, frac_nucl, beta_prec_fisrt, 2770 2841 . prfl, psfl, rhcl, 2771 2842 . zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cldcon ) … … 3145 3216 3146 3217 if (ok_newmicro) then 3147 CALL newmicro (paprs, pplay,ok_newmicro, 3148 . t_seri, cldliq, cldfra, cldtau, cldemi, 3149 . cldh, cldl, cldm, cldt, cldq, 3150 . flwp, fiwp, flwc, fiwc, 3151 e ok_aie, 3152 e mass_solu_aero, mass_solu_aero_pi, 3153 e bl95_b0, bl95_b1, 3154 s cldtaupi, re, fl, ref_liq, ref_ice) 3218 CALL newmicro (ok_cdnc, bl95_b0, bl95_b1, 3219 . paprs, pplay, t_seri, cldliq, cldfra, 3220 . cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, 3221 e flwp, fiwp, flwc, fiwc, 3222 e mass_solu_aero, mass_solu_aero_pi, 3223 s cldtaupi, re, fl, ref_liq, ref_ice) 3155 3224 else 3156 3225 CALL nuage (paprs, pplay, … … 3161 3230 e bl95_b0, bl95_b1, 3162 3231 s cldtaupi, re, fl) 3163 3164 3232 endif 3165 3233 c … … 3169 3237 cldtaupirad = cldtaupi 3170 3238 cldemirad = cldemi 3239 3171 3240 c 3172 3241 if(lon1_beta.EQ.-180..AND.lon2_beta.EQ.180..AND. … … 3188 3257 cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k) 3189 3258 cldemirad(i,k) = cldemi(i,k) * beta(i,k) 3259 cldfrarad(i,k) = cldfra(i,k) * beta(i,k) 3190 3260 ENDDO 3191 3261 ENDDO … … 3211 3281 cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k) 3212 3282 cldemirad(i,k) = cldemi(i,k) * beta(i,k) 3283 cldfrarad(i,k) = cldfra(i,k) * beta(i,k) 3213 3284 endif 3214 3285 c … … 3246 3317 e paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, 3247 3318 e wo(:, :, 1), 3248 e cldfra , cldemirad, cldtaurad,3319 e cldfrarad, cldemirad, cldtaurad, 3249 3320 s heat,heat0,cool,cool0,radsol,albpla, 3250 3321 s topsw,toplw,solsw,sollw, … … 3281 3352 e paprs, pplay,zxtsol,albsol1, albsol2, 3282 3353 e t_seri,q_seri,wo, 3283 e cldfra , cldemirad, cldtaurad,3354 e cldfrarad, cldemirad, cldtaurad, 3284 3355 e ok_ade, ok_aie, flag_aerosol, 3285 3356 e tau_aero, piz_aero, cg_aero, … … 3304 3375 cIM Par defaut on a les taux perturbes egaux aux taux actuels 3305 3376 c 3377 if (ok_4xCO2atm) then 3306 3378 if (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. 3307 3379 $RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. … … 3340 3412 o topswcf_aerop, solswcf_aerop) 3341 3413 endif 3414 endif 3342 3415 c 3343 3416 ENDIF ! aerosol_couple … … 3590 3663 $ prfl(:,1:klev),psfl(:,1:klev), 3591 3664 $ pmflxr(:,1:klev),pmflxs(:,1:klev), 3592 $ mr_ozone,cldtau rad, cldemirad)3665 $ mr_ozone,cldtau, cldemi) 3593 3666 3594 3667 ! L calipso2D,calipso3D,cfadlidar,parasolrefl,atb,betamol, … … 3620 3693 I itap, days_elapsed+1, jH_cur, debut, 3621 3694 I lafin, dtime, u, v, t, 3622 I paprs, pplay, pmfu, pmfd, 3695 I paprs, pplay, pmfu, pmfd, 3623 3696 I pen_u, pde_u, pen_d, pde_d, 3624 3697 I cdragh, coefh, fm_therm, entr_therm, 3625 3698 I u1, v1, ftsol, pctsrf, 3626 3699 I ustar, u10m, v10m, 3627 I rlat, frac_impa, frac_nucl,rlon, 3700 I rlat, rlon, 3701 I frac_impa,frac_nucl, beta_prec_fisrt,beta_prec, 3628 3702 I presnivs, pphis, pphi, albsol1, 3629 I sh_in, rhcl, cldfra, rneb, 3703 I sh_in, rhcl, cldfra, rneb, 3630 3704 I diafra, cldliq, itop_con, ibas_con, 3631 3705 I pmflxr, pmflxs, prfl, psfl, 3632 I da, phi, mp, upwd, 3706 I da, phi, mp, upwd, 3707 I phi2, d1a, dam, sij, !<<RomP 3708 I wdtrainA, wdtrainM, sigd, clw,elij, !<<RomP 3709 I ev, ep, epmlmMm, eplaMm, !<<RomP 3633 3710 I dnwd, aerosol_couple, flxmass_w, 3634 3711 I tau_aero, piz_aero, cg_aero, ccm, 3635 3712 I rfname, 3713 I d_tr_dyn, !<<RomP 3636 3714 O tr_seri) 3637 3715 … … 3805 3883 ENDDO 3806 3884 ENDDO 3807 c 3885 3886 !!! RomP >>> 3887 IF (nqtot.GE.3) THEN 3888 DO iq = 3, nqtot 3889 DO k = 1, klev 3890 DO i = 1, klon 3891 tr_ancien(i,k,iq-2) = tr_seri(i,k,iq-2) 3892 ENDDO 3893 ENDDO 3894 ENDDO 3895 ENDIF 3896 !!! RomP <<< 3808 3897 !========================================================================== 3809 3898 ! Sorties des tendances pour un point particulier -
LMDZ5/branches/testing/libf/phylmd/phytrac.F90
r1707 r1750 3 3 SUBROUTINE phytrac( & 4 4 nstep, julien, gmtime, debutphy, & 5 lafin, pdtphys, u, v, t_seri, 5 lafin, pdtphys, u, v, t_seri, & 6 6 paprs, pplay, pmfu, pmfd, & 7 7 pen_u, pde_u, pen_d, pde_d, & … … 9 9 yu1, yv1, ftsol, pctsrf, & 10 10 ustar, u10m, v10m, & 11 xlat, frac_impa,frac_nucl,xlon, & 11 xlat, xlon, & 12 frac_impa,frac_nucl,beta_fisrt,beta_v1, & 12 13 presnivs, pphis, pphi, albsol, & 13 14 sh, rh, cldfra, rneb, & … … 15 16 pmflxr, pmflxs, prfl, psfl, & 16 17 da, phi, mp, upwd, & 18 phi2, d1a, dam, sij, & ! RomP 19 wdtrainA, wdtrainM, sigd, clw,elij, & ! RomP 20 evap, ep, epmlmMm, eplaMm, & ! RomP 17 21 dnwd, aerosol_couple, flxmass_w, & 18 22 tau_aero, piz_aero, cg_aero, ccm, & 19 23 rfname, & 24 d_tr_dyn, & ! RomP 20 25 tr_seri) 21 26 ! … … 23 28 ! Auteur(s) FH 24 29 ! Objet: Moniteur general des tendances traceurs 30 ! Modification R. Pilon 01 janvier 2012 transport+scavenging KE scheme : cvltr 31 ! Modification R. Pilon 10 octobre 2012 large scale scavenging incloud_scav + bc_scav 25 32 !====================================================================== 26 33 27 34 USE ioipsl 35 USE phys_cal_mod, only : hour 36 USE phys_output_mod, only : convers_timesteps 28 37 USE dimphy 29 38 USE infotrac … … 36 45 USE tracreprobus_mod 37 46 USE control_mod 38 39 47 40 48 IMPLICIT NONE … … 68 76 !-------- 69 77 REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature 70 REAL,DIMENSION(klon,klev),INTENT(IN) :: u ! variable not used 71 REAL,DIMENSION(klon,klev),INTENT(IN) :: v ! variable not used 78 REAL,DIMENSION(klon,klev),INTENT(IN) :: u ! variable not used 79 REAL,DIMENSION(klon,klev),INTENT(IN) :: v ! variable not used 72 80 REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique 73 81 REAL,DIMENSION(klon,klev),INTENT(IN) :: rh ! humidite relative … … 81 89 REAL,DIMENSION(klon,klev),INTENT(IN) :: diafra ! fraction nuageuse (convection ou stratus artificiels) 82 90 REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb ! fraction nuageuse (grande echelle) 91 ! 92 REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb 93 REAL,DIMENSION(klon,klev),INTENT(IN) :: beta_fisrt ! taux de conversion de l'eau cond (de fisrtilp) 94 REAL,DIMENSION(klon,klev),INTENT(out) :: beta_v1 ! -- (originale version) 95 96 ! 83 97 INTEGER,DIMENSION(klon),INTENT(IN) :: itop_con 84 98 INTEGER,DIMENSION(klon),INTENT(IN) :: ibas_con 85 99 REAL,DIMENSION(klon),INTENT(IN) :: albsol ! albedo surface 100 ! 101 !Dynamique 102 !-------- 103 REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: d_tr_dyn 86 104 ! 87 105 !Convection: … … 108 126 REAL,DIMENSION(klon,klev),INTENT(IN) :: da 109 127 REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi 128 ! RomP >>> 129 REAL,DIMENSION(klon,klev),INTENT(IN) :: d1a,dam 130 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2 131 ! 132 REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainA 133 REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainM 134 REAL,DIMENSION(klon),INTENT(IN) :: sigd 135 ! ---- RomP flux entraine, detraine et precipitant kerry Emanuel 136 REAL,DIMENSION(klon,klev),INTENT(IN) :: evap 137 REAL,DIMENSION(klon,klev),INTENT(IN) :: ep 138 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij 139 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij 140 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm 141 REAL,DIMENSION(klon,klev),INTENT(IN) :: eplaMm 142 REAL,DIMENSION(klon,klev),INTENT(IN) :: clw 143 ! RomP <<< 144 145 ! 110 146 REAL,DIMENSION(klon,klev),INTENT(IN) :: mp 111 147 REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! saturated updraft mass flux … … 120 156 !-------------- 121 157 ! 122 REAL,DIMENSION(klon),INTENT(IN) :: cdragh ! coeff drag pour T et Q123 REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh ! coeff melange CL (m**2/s)124 REAL,DIMENSION(klon),INTENT(IN) :: ustar,u10m,v10m ! u* & vent a 10m (m/s)125 REAL,DIMENSION(klon),INTENT(IN) :: yu1 ! vents au premier niveau126 REAL,DIMENSION(klon),INTENT(IN) :: yv1 ! vents au premier niveau158 REAL,DIMENSION(klon),INTENT(IN) :: cdragh ! coeff drag pour T et Q 159 REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh ! coeff melange CL (m**2/s) 160 REAL,DIMENSION(klon),INTENT(IN) :: ustar,u10m,v10m ! u* & vent a 10m (m/s) 161 REAL,DIMENSION(klon),INTENT(IN) :: yu1 ! vents au premier niveau 162 REAL,DIMENSION(klon),INTENT(IN) :: yv1 ! vents au premier niveau 127 163 ! 128 164 !Lessivage: … … 141 177 ! Output argument 142 178 !---------------- 143 REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA] 144 179 REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA] 180 REAL,DIMENSION(klon,klev) :: sourceBE 145 181 !======================================================================================= 146 182 ! -- LOCAL VARIABLES -- … … 153 189 !-------------------------------------------- 154 190 ! 155 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: source ! a voir lorsque le flux de surface est prescrit 191 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: source ! a voir lorsque le flux de surface est prescrit 156 192 !$OMP THREADPRIVATE(source) 157 193 … … 166 202 REAL,DIMENSION(klon) :: zx_tmp_fi2d ! variable temporaire grille physique 167 203 INTEGER :: itau_w ! pas de temps ecriture = nstep + itau_phy 168 LOGICAL,PARAMETER :: ok_sync=.TRUE. 204 LOGICAL,PARAMETER :: ok_sync=.TRUE. 205 CHARACTER(len=20) :: chtratimestep 169 206 170 207 ! … … 175 212 REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa) 176 213 ! 177 ! Tendances de traceurs (Td) :214 ! Tendances de traceurs (Td) et flux de traceurs: 178 215 !------------------------ 179 !180 216 REAL,DIMENSION(klon,klev) :: d_tr ! Td dans l'atmosphere 181 217 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_cl ! Td couche limite/traceur 218 REAL,DIMENSION(klon,nbtr) :: d_tr_dry ! Td depot sec/traceur (1st layer) jyg 219 REAL,DIMENSION(klon,nbtr) :: flux_tr_dry ! depot sec/traceur (surface) jyg 220 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_dec !RomP 182 221 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_cv ! Td convection/traceur 222 ! RomP >>> 223 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_insc 224 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_bcscav 225 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_evapls 226 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_ls 227 REAL,DIMENSION(klon,nbtr) :: qPrls !jyg: concentration tra dans pluie LS a la surf. 228 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_trsp 229 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_sscav 230 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_sat 231 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_uscav 232 REAL,DIMENSION(klon,klev,nbtr) :: qPr,qDi ! concentration tra dans pluie,air descente insaturee 233 REAL,DIMENSION(klon,klev,nbtr) :: qPa,qMel 234 REAL,DIMENSION(klon,klev,nbtr) :: qTrdi,dtrcvMA ! conc traceur descente air insaturee et td convective MA 235 REAL,DIMENSION(klon,klev) :: Mint 236 REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a 237 REAL,DIMENSION(klon,klev,nbtr) :: zmfdam 238 REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2 239 ! RomP <<< 183 240 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_th ! Td thermique 184 241 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_lessi_impa ! Td du lessivage par impaction 185 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_lessi_nucl ! Td du lessivage par nucleation 242 REAL,DIMENSION(klon,klev,nbtr) :: d_tr_lessi_nucl ! Td du lessivage par nucleation 186 243 ! 187 244 ! Physique 188 !---------- 245 !---------- 189 246 REAL,DIMENSION(klon,klev,nbtr) :: flestottr ! flux de lessivage dans chaque couche 190 247 REAL,DIMENSION(klon,klev) :: zmasse ! densité atmosphérique Kg/m2 191 248 REAL,DIMENSION(klon,klev) :: ztra_th 249 !PhH 250 REAL,DIMENSION(klon,klev) :: zrho 251 REAL,DIMENSION(klon,klev) :: zdz 252 REAL :: evaplsc,dx,beta ! variable pour lessivage Genthon 253 REAL,DIMENSION(klon) :: his_dh ! --- 254 ! in-cloud scav variables 255 REAL :: ql_incloud_ref ! ref value of in-cloud condensed water content 192 256 193 257 !Controles: … … 199 263 200 264 CHARACTER(len=8),DIMENSION(nbtr) :: solsym 201 202 265 !RomP >>> 266 INTEGER,SAVE :: iflag_lscav 267 LOGICAL,SAVE :: convscav 268 !$OMP THREADPRIVATE(iflag_lscav,convscav) 269 !RomP <<< 203 270 !###################################################################### 204 271 ! -- INITIALIZATION -- 205 272 !###################################################################### 273 DO k=1,klev 274 DO i=1,klon 275 sourceBE(i,k)=0. 276 Mint(i,k)=0. 277 zrho(i,k)=0. 278 zdz(i,k)=0. 279 END DO 280 END DO 281 282 DO it=1, nbtr 283 DO k=1,klev 284 DO i=1,klon 285 d_tr_insc(i,k,it)=0. 286 d_tr_bcscav(i,k,it)=0. 287 d_tr_evapls(i,k,it)=0. 288 d_tr_ls(i,k,it)=0. 289 d_tr_cv(i,k,it)=0. 290 d_tr_cl(i,k,it)=0. 291 d_tr_trsp(i,k,it)=0. 292 d_tr_sscav(i,k,it)=0. 293 d_tr_sat(i,k,it)=0. 294 d_tr_uscav(i,k,it)=0. 295 d_tr_lessi_impa(i,k,it)=0. 296 d_tr_lessi_nucl(i,k,it)=0. 297 qDi(i,k,it)=0. 298 qPr(i,k,it)=0. 299 qPa(i,k,it)=0. 300 qMel(i,k,it)=0. 301 qTrdi(i,k,it)=0. 302 dtrcvMA(i,k,it)=0. 303 zmfd1a(i,k,it)=0. 304 zmfdam(i,k,it)=0. 305 zmfphi2(i,k,it)=0. 306 END DO 307 END DO 308 END DO 206 309 IF (debutphy) THEN 207 IF (prt_level >9) WRITE(lunout,*) 'FIRST TIME IN PHYTRAC : pdtphys(sec) = ',pdtphys,'ecrit_tra (sec) = ',ecrit_tra 310 !!jyg 311 chtratimestep='DefFreq' 312 CALL getin('tra_time_step',chtratimestep) 313 IF (chtratimestep .NE. 'DefFreq') THEN 314 call convers_timesteps(chtratimestep,pdtphys,ecrit_tra) 315 ENDIF 316 !RomP >>> 317 ! 318 !Config Key = convscav 319 !Config Desc = Convective scavenging switch: 0=off, 1=on. 320 !Config Def = .false. 321 !Config Help = 322 ! 323 convscav=.false. 324 call getin('convscav', convscav) 325 print*,'phytrac passage dans routine conv avec lessivage', convscav 326 ! 327 !Config Key = iflag_lscav 328 !Config Desc = Large scale scavenging parametrization: 0=none, 1=old(Genthon92), 329 ! 2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon. 330 !Config Def = 1 331 !Config Help = 332 ! 333 iflag_lscav=1 334 call getin('iflag_lscav', iflag_lscav) 335 ! 336 SELECT CASE(iflag_lscav) 337 CASE(0) 338 PRINT*, 'Large scale scavenging: none' 339 CASE(1) 340 PRINT*, 'Large scale scavenging: C. Genthon, Tellus(1992), 44B, 371-389' 341 CASE(2) 342 PRINT*, 'Large scale scavenging: C. Genthon, modified P. Heinrich' 343 CASE(3) 344 PRINT*, 'Large scale scavenging: M. Shekkar Reddy and O. Boucher, JGR(2004), 109, D14202' 345 CASE(4) 346 PRINT*, 'Large scale scavenging: Reddy and Boucher, modified R. Pilon' 347 END SELECT 348 !RomP <<< 349 WRITE(*,*) 'FIRST TIME IN PHYTRAC : pdtphys(sec) = ',pdtphys,'ecrit_tra (sec) = ',ecrit_tra 208 350 ALLOCATE( source(klon,nbtr), stat=ierr) 209 351 IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 1',1) … … 237 379 END DO 238 380 END DO 381 ! 382 IF (id_be .GT. 0) THEN 383 DO k=1,klev 384 DO i=1,klon 385 sourceBE(i,k)=srcbe(i,k) !RomP -> pour sortie histrac 386 END DO 387 END DO 388 ENDIF 239 389 240 390 !=============================================================================== … … 246 396 ! -- Traitement des traceurs avec traclmdz 247 397 CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, & 248 cdragh, coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon,couchelimite,sh, &398 cdragh, coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon,couchelimite,sh, & 249 399 rh, pphi, ustar, u10m, v10m, & 250 tr_seri, source, solsym, d_tr_cl, zmasse) 400 !! tr_seri, source, solsym, d_tr_cl, zmasse) !RomP 401 tr_seri, source, solsym, d_tr_cl,d_tr_dec, zmasse) !RomP 251 402 CASE('inca') 252 403 ! -- CHIMIE INCA config_inca = aero or chem -- … … 273 424 274 425 END SELECT 275 276 426 !====================================================================== 277 427 ! -- Calcul de l'effet de la convection -- 278 428 !====================================================================== 429 279 430 IF (convection) THEN 280 431 DO it=1, nbtr 281 432 IF ( conv_flg(it) == 0 ) CYCLE 282 283 433 IF (iflag_con.LT.2) THEN 284 d_tr_cv(:,:, :)=0.434 d_tr_cv(:,:,it)=0. 285 435 ELSE IF (iflag_con.EQ.2) THEN 286 436 !..Tiedke 287 437 CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & 288 438 pplay, paprs, tr_seri(:,:,it), d_tr_cv(:,:,it)) 289 ELSE 290 !..K.Emanuel 291 CALL cvltr(pdtphys, da, phi, mp, paprs,pplay, tr_seri(:,:,it),& 292 upwd,dnwd,d_tr_cv(:,:,it)) 439 ! RomP >>> 440 ELSE 441 !..K.Emanuel !RomP modif arg 442 if (convscav.and.aerosol(it)) then ! lessivage convectif pour aerosol 443 ! 444 CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep, & 445 sigd,sij,clw,elij,epmlmMm,eplaMm, & 446 pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM, & 447 paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con, & 448 d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,& 449 qPa,qMel,qTrdi,dtrcvMA,Mint, & 450 zmfd1a,zmfphi2,zmfdam) 451 else !pas de lessivage convectif ou n'est pas un aerosol 452 CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,& 453 upwd,dnwd,d_tr_cv) 454 endif 293 455 END IF 456 ! RomP <<< 294 457 295 458 DO k = 1, klev … … 357 520 tr_seri(:,:,it), source(:,it), & 358 521 paprs, pplay, delp, & 359 d_tr_cl(:,:,it) )522 d_tr_cl(:,:,it),d_tr_dry(:,it),flux_tr_dry(:,it)) 360 523 361 524 DO k = 1, klev … … 372 535 373 536 !====================================================================== 374 ! Calcul de l'effet de la precipitation 375 !====================================================================== 376 537 ! Calcul de l'effet de la precipitation grande echelle 538 !====================================================================== 377 539 IF (lessivage) THEN 378 540 541 ql_incloud_ref = 10.e-4 542 ql_incloud_ref = 5.e-4 543 544 545 ! calcul du contenu en eau liquide au sein du nuage 546 ql_incl = ql_incloud_ref 547 ! choix du lessivage 548 ! 549 IF (iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) THEN 550 ! ******** Olivier Boucher version (3) possibly with modified ql_incl (4) 551 ! 552 DO it = 1, nbtr 553 ! incloud scavenging and removal by large scale rain ! orig : ql_incl was replaced by 0.5e-3 kg/kg 554 ! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR 555 ! Liu (2001) proposed to use 1.5e-3 kg/kg 556 557 CALL lsc_scav(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl,rneb,beta_fisrt, & 558 beta_v1,pplay,paprs,t_seri,tr_seri,d_tr_insc, & 559 d_tr_bcscav,d_tr_evapls,qPrls) 560 561 !large scale scavenging tendency 562 DO k = 1, klev 563 DO i = 1, klon 564 d_tr_ls(i,k,it)=d_tr_insc(i,k,it)+d_tr_bcscav(i,k,it)+d_tr_evapls(i,k,it) 565 tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr_ls(i,k,it) 566 ENDDO 567 ENDDO 568 CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'lsc scav it = '//solsym(it)) 569 END DO !tr 570 571 ELSE IF (iflag_lscav .EQ. 2) THEN ! frac_impa, frac_nucl 572 ! ********* modified old version 573 574 d_tr_lessi_nucl(:,:,:) = 0. 575 d_tr_lessi_impa(:,:,:) = 0. 576 flestottr(:,:,:) = 0. 577 ! Tendance des aerosols nuclees et impactes 578 DO it = 1, nbtr 579 IF (aerosol(it)) THEN 580 his_dh(:)=0. 581 DO k = 1, klev 582 DO i = 1, klon 583 !PhH 584 zrho(i,k)=pplay(i,k)/t_seri(i,k)/RD 585 zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG 586 ! 587 END DO 588 END DO 589 590 DO k=klev-1, 1, -1 591 DO i=1, klon 592 ! d_tr_ls(i,k,it)=tr_seri(i,k,it)*(frac_impa(i,k)*frac_nucl(i,k)-1.) 593 dx=d_tr_ls(i,k,it) 594 his_dh(i)=his_dh(i)-dx*zrho(i,k)*zdz(i,k)/pdtphys ! kg/m2/s 595 evaplsc = prfl(i,k) - prfl(i,k+1) + psfl(i,k) - psfl(i,k+1) 596 ! Evaporation Partielle -> Liberation Partielle 0.5*evap 597 IF ( evaplsc .LT.0..and.abs(prfl(i,k+1)+psfl(i,k+1)).gt.1.e-10) THEN 598 evaplsc = (-evaplsc)/(prfl(i,k+1)+psfl(i,k+1)) 599 ! evaplsc est donc positif, his_dh(i) est positif 600 !-------------- 601 d_tr_evapls(i,k,it)=0.5*evaplsc*(d_tr_lessi_nucl(i,k+1,it) & 602 +d_tr_lessi_impa(i,k+1,it)) 603 !------------- d_tr_evapls(i,k,it)=-0.5*evaplsc*(d_tr_lsc(i,k+1,it)) 604 beta=0.5*evaplsc 605 if ((prfl(i,k)+psfl(i,k)).lt.1.e-10) THEN 606 beta=1.0*evaplsc 607 endif 608 dx=beta*his_dh(i)/zrho(i,k)/zdz(i,k)*pdtphys 609 his_dh(i)=(1.-beta)*his_dh(i) ! tracer from 610 d_tr_evapls(i,k,it)=dx 611 ENDIF 612 d_tr_ls(i,k,it)=tr_seri(i,k,it)*(frac_impa(i,k)*frac_nucl(i,k)-1.) & 613 +d_tr_evapls(i,k,it) 614 615 !-------------- 616 d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + & 617 ( 1 - frac_nucl(i,k) )*tr_seri(i,k,it) 618 d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + & 619 ( 1 - frac_impa(i,k) )*tr_seri(i,k,it) 620 ! 621 ! Flux lessivage total 622 flestottr(i,k,it) = flestottr(i,k,it) - & 623 ( d_tr_lessi_nucl(i,k,it) + & 624 d_tr_lessi_impa(i,k,it) ) * & 625 ( paprs(i,k)-paprs(i,k+1) ) / & 626 (RG * pdtphys) 627 !! Mise a jour des traceurs due a l'impaction,nucleation 628 ! tr_seri(i,k,it)=tr_seri(i,k,it)*frac_impa(i,k)*frac_nucl(i,k) 629 !! calcul de la tendance liee au lessivage stratiforme 630 ! d_tr_ls(i,k,it)=tr_seri(i,k,it)*& 631 ! (1.-1./(frac_impa(i,k)*frac_nucl(i,k))) 632 !-------------- 633 END DO 634 END DO 635 END IF 636 END DO 637 ! ********* end modified old version 638 639 ELSE IF (iflag_lscav .EQ. 1) THEN ! frac_impa, frac_nucl 640 ! ********* old version 641 379 642 d_tr_lessi_nucl(:,:,:) = 0. 380 643 d_tr_lessi_impa(:,:,:) = 0. … … 412 675 END DO 413 676 414 END IF ! lessivage 677 ! ********* end old version 678 ENDIF ! iflag_lscav . EQ. 1, 2, 3 or 4 679 ! 680 END IF ! lessivage 415 681 416 682 !============================================================= -
LMDZ5/branches/testing/libf/phylmd/readaerosol_interp.F90
r1665 r1750 20 20 USE write_field_phy 21 21 USE phys_cal_mod 22 USE pres2lev_mod 22 23 23 24 IMPLICIT NONE -
LMDZ5/branches/testing/libf/phylmd/surf_land_bucket_mod.F90
r1146 r1750 24 24 USE cpl_mod 25 25 USE dimphy 26 USE comgeomphy 26 27 USE mod_grid_phy_lmdz 27 28 USE mod_phys_lmdz_para … … 97 98 ! calculate constants 98 99 CALL calbeta(dtime, is_ter, knon, snow, qsol, beta, capsol, dif_grnd) 100 if (type_veget=='betaclim') then 101 CALL calbeta_clim(knon,jour,rlatd(knindex(:)),beta) 102 endif 99 103 100 104 ! calculate temperature, heat capacity and conduction flux in soil … … 107 111 ELSE 108 112 cal(:) = RCPD * capsol(:) 113 IF (klon_glo .EQ. 1) THEN 114 cal(:) = 0. 115 ENDIF 109 116 ENDIF 110 117 -
LMDZ5/branches/testing/libf/phylmd/surface_data.F90
r996 r1750 9 9 10 10 LOGICAL, SAVE :: ok_veget ! true for use of vegetation model ORCHIDEE 11 CHARACTER(len=10), SAVE :: type_veget ! orchidee/y/bucket/n/betaclim 11 12 !$OMP THREADPRIVATE(ok_veget) 12 13 -
LMDZ5/branches/testing/libf/phylmd/thermcellV0_main.F90
r1403 r1750 519 519 !------------------------------------------------------------------ 520 520 521 call thermcell_dq(ngrid,nlay, ptimestep,fm0,entr0,masse, &521 call thermcell_dq(ngrid,nlay,1,ptimestep,fm0,entr0,masse, & 522 522 & zthl,zdthladj,zta,lev_out) 523 call thermcell_dq(ngrid,nlay, ptimestep,fm0,entr0,masse, &523 call thermcell_dq(ngrid,nlay,1,ptimestep,fm0,entr0,masse, & 524 524 & po,pdoadj,zoa,lev_out) 525 525 … … 561 561 562 562 ! calcul purement conservatif pour le transport de V 563 call thermcell_dq(ngrid,nlay, ptimestep,fm0,entr0,masse &563 call thermcell_dq(ngrid,nlay,1,ptimestep,fm0,entr0,masse & 564 564 & ,zu,pduadj,zua,lev_out) 565 call thermcell_dq(ngrid,nlay, ptimestep,fm0,entr0,masse &565 call thermcell_dq(ngrid,nlay,1,ptimestep,fm0,entr0,masse & 566 566 & ,zv,pdvadj,zva,lev_out) 567 567 endif -
LMDZ5/branches/testing/libf/phylmd/thermcell_dq.F90
r1403 r1750 1 subroutine thermcell_dq(ngrid,nlay, ptimestep,fm,entr, &1 subroutine thermcell_dq(ngrid,nlay,impl,ptimestep,fm,entr, & 2 2 & masse,q,dq,qa,lev_out) 3 3 implicit none … … 10 10 ! calcul du dq/dt une fois qu'on connait les ascendances 11 11 ! 12 ! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr) 13 ! Introduction of an implicit computation of vertical advection in 14 ! the environment of thermal plumes in thermcell_dq 15 ! impl = 0 : explicit, 1 : implicit, -1 : old version 16 ! 12 17 !======================================================================= 13 18 14 integer ngrid,nlay 19 integer ngrid,nlay,impl 15 20 16 21 real ptimestep … … 28 33 real cfl 29 34 30 real qold(ngrid,nlay) 31 real ztimestep 35 real qold(ngrid,nlay),fqa(ngrid,nlay+1) 32 36 integer niter,iter 33 37 CHARACTER (LEN=20) :: modname='thermcell_dq' … … 35 39 36 40 41 ! Old explicite scheme 42 if (impl==-1) then 43 call thermcell_dq_o(ngrid,nlay,ptimestep,fm,entr, & 44 & masse,q,dq,qa,lev_out) 45 return 46 endif 37 47 38 48 ! Calcul du critere CFL pour l'advection dans la subsidence … … 50 60 enddo 51 61 52 !IM 090508 print*,'CFL CFL CFL CFL ',cfl53 54 #undef CFL55 #ifdef CFL56 ! On subdivise le calcul en niter pas de temps.57 niter=int(cfl)+158 #else59 niter=160 #endif61 62 ztimestep=ptimestep/niter63 62 qold=q 64 63 65 64 66 do iter=1,niter67 65 if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0' 68 66 … … 88 86 enddo 89 87 88 ! Computation of tracer concentrations in the ascending plume 89 do ig=1,ngrid 90 qa(ig,1)=q(ig,1) 91 enddo 92 93 do k=2,nlay 94 do ig=1,ngrid 95 if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt. & 96 & 1.e-5*masse(ig,k)) then 97 qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k)) & 98 & /(fm(ig,k+1)+detr(ig,k)) 99 else 100 qa(ig,k)=q(ig,k) 101 endif 102 if (qa(ig,k).lt.0.) then 103 ! print*,'qa<0!!!' 104 endif 105 if (q(ig,k).lt.0.) then 106 ! print*,'q<0!!!' 107 endif 108 enddo 109 enddo 110 111 ! Plume vertical flux 112 do k=2,nlay-1 113 fqa(:,k)=fm(:,k)*qa(:,k-1) 114 enddo 115 fqa(:,1)=0. ; fqa(:,nlay)=0. 116 117 118 ! Trace species evolution 119 if (impl==0) then 120 do k=1,nlay-1 121 q(:,k)=q(:,k)+(fqa(:,k)-fqa(:,k+1)-fm(:,k)*q(:,k)+fm(:,k+1)*q(:,k+1)) & 122 & *ptimestep/masse(:,k) 123 enddo 124 else 125 do k=nlay-1,1,-1 126 q(:,k)=(masse(:,k)*q(:,k)/ptimestep+fqa(:,k)-fqa(:,k+1)+fm(:,k+1)*q(:,k+1)) & 127 & /(fm(:,k)+masse(:,k)/ptimestep) 128 enddo 129 endif 130 131 ! Tendencies 132 do k=1,nlay 133 do ig=1,ngrid 134 dq(ig,k)=(q(ig,k)-qold(ig,k))/ptimestep 135 q(ig,k)=qold(ig,k) 136 enddo 137 enddo 138 139 return 140 end 141 142 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 143 ! Obsolete version kept for convergence with Cmip5 NPv3.1 simulations 144 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 145 146 subroutine thermcell_dq_o(ngrid,nlay,ptimestep,fm,entr, & 147 & masse,q,dq,qa,lev_out) 148 implicit none 149 150 #include "iniprint.h" 151 !======================================================================= 152 ! 153 ! Calcul du transport verticale dans la couche limite en presence 154 ! de "thermiques" explicitement representes 155 ! calcul du dq/dt une fois qu'on connait les ascendances 156 ! 157 !======================================================================= 158 159 integer ngrid,nlay 160 161 real ptimestep 162 real masse(ngrid,nlay),fm(ngrid,nlay+1) 163 real entr(ngrid,nlay) 164 real q(ngrid,nlay) 165 real dq(ngrid,nlay) 166 integer lev_out ! niveau pour les print 167 168 real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1) 169 170 real zzm 171 172 integer ig,k 173 real cfl 174 175 real qold(ngrid,nlay) 176 real ztimestep 177 integer niter,iter 178 CHARACTER (LEN=20) :: modname='thermcell_dq' 179 CHARACTER (LEN=80) :: abort_message 180 181 182 183 ! Calcul du critere CFL pour l'advection dans la subsidence 184 cfl = 0. 185 do k=1,nlay 186 do ig=1,ngrid 187 zzm=masse(ig,k)/ptimestep 188 cfl=max(cfl,fm(ig,k)/zzm) 189 if (entr(ig,k).gt.zzm) then 190 print*,'entr dt > m ',entr(ig,k)*ptimestep,masse(ig,k) 191 abort_message = '' 192 CALL abort_gcm (modname,abort_message,1) 193 endif 194 enddo 195 enddo 196 197 !IM 090508 print*,'CFL CFL CFL CFL ',cfl 198 199 #undef CFL 200 #ifdef CFL 201 ! On subdivise le calcul en niter pas de temps. 202 niter=int(cfl)+1 203 #else 204 niter=1 205 #endif 206 207 ztimestep=ptimestep/niter 208 qold=q 209 210 211 do iter=1,niter 212 if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0' 213 214 ! calcul du detrainement 215 do k=1,nlay 216 do ig=1,ngrid 217 detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k) 218 ! print*,'Q2 DQ ',detr(ig,k),fm(ig,k),entr(ig,k) 219 !test 220 if (detr(ig,k).lt.0.) then 221 entr(ig,k)=entr(ig,k)-detr(ig,k) 222 detr(ig,k)=0. 223 ! print*,'detr2<0!!!','ig=',ig,'k=',k,'f=',fm(ig,k), 224 ! s 'f+1=',fm(ig,k+1),'e=',entr(ig,k),'d=',detr(ig,k) 225 endif 226 if (fm(ig,k+1).lt.0.) then 227 ! print*,'fm2<0!!!' 228 endif 229 if (entr(ig,k).lt.0.) then 230 ! print*,'entr2<0!!!' 231 endif 232 enddo 233 enddo 234 90 235 ! calcul de la valeur dans les ascendances 91 236 do ig=1,ngrid -
LMDZ5/branches/testing/libf/phylmd/thermcell_main.F90
r1669 r1750 22 22 23 23 USE dimphy 24 USE ioipsl 24 25 USE comgeomphy , ONLY:rlond,rlatd 25 26 IMPLICIT NONE … … 44 45 ! 4. un detrainement 45 46 ! 47 ! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr) 48 ! Introduction of an implicit computation of vertical advection in 49 ! the environment of thermal plumes in thermcell_dq 50 ! impl = 0 : explicit, 1 : implicit, -1 : old version 51 ! controled by iflag_thermals = 52 ! 15, 16 run with impl=-1 : numerical convergence with NPv3 53 ! 17, 18 run with impl=1 : more stable 54 ! 15 and 17 correspond to the activation of the stratocumulus "bidouille" 55 ! 46 56 !======================================================================= 57 47 58 48 59 !----------------------------------------------------------------------- … … 79 90 80 91 integer icount 92 93 integer, save :: dvdq=1,dqimpl=-1 94 !$OMP THREADPRIVATE(dvdq,dqimpl) 81 95 data icount/0/ 82 96 save icount … … 247 261 248 262 if (debut) then 263 ! call getin('dvdq',dvdq) 264 ! call getin('dqimpl',dqimpl) 265 266 if (iflag_thermals==15.or.iflag_thermals==16) then 267 dvdq=0 268 dqimpl=-1 269 else 270 dvdq=1 271 dqimpl=1 272 endif 273 249 274 fm0=0. 250 275 entr0=0. … … 593 618 !------------------------------------------------------------------ 594 619 595 call thermcell_dq(ngrid,nlay, ptimestep,fm0,entr0,masse, &620 call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse, & 596 621 & zthl,zdthladj,zta,lev_out) 597 call thermcell_dq(ngrid,nlay, ptimestep,fm0,entr0,masse, &622 call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse, & 598 623 & po,pdoadj,zoa,lev_out) 599 624 … … 620 645 621 646 !IM 090508 622 if (1.eq.1) then 623 !IM 070508 vers. _dq 624 ! if (1.eq.0) then 625 647 if (dvdq == 0 ) then 626 648 627 649 ! Calcul du transport de V tenant compte d'echange par gradient … … 629 651 630 652 call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse & 631 & ,fraca,zmax & 653 ! & ,fraca*dvdq,zmax & 654 & ,fraca,zmax & 632 655 & ,zu,zv,pduadj,pdvadj,zua,zva,lev_out) 633 656 … … 635 658 636 659 ! calcul purement conservatif pour le transport de V 637 call thermcell_dq(ngrid,nlay, ptimestep,fm0,entr0,masse &660 call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse & 638 661 & ,zu,pduadj,zua,lev_out) 639 call thermcell_dq(ngrid,nlay, ptimestep,fm0,entr0,masse &662 call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse & 640 663 & ,zv,pdvadj,zva,lev_out) 664 641 665 endif 642 666 -
LMDZ5/branches/testing/libf/phylmd/traclmdz_mod.F90
r1707 r1750 2 2 ! 3 3 MODULE traclmdz_mod 4 4 5 ! 5 6 ! In this module all tracers specific to LMDZ are treated. This module is used … … 117 118 REAL, DIMENSION(klev) :: mintmp, maxtmp 118 119 LOGICAL :: zero 119 120 ! RomP >>> profil initial Be7 121 integer ilesfil 122 parameter (ilesfil=1) 123 integer irr,kradio 124 real beryllium(klon,klev) 125 ! profil initial Pb210 126 integer ilesfil2 127 parameter (ilesfil2=1) 128 integer irr2,kradio2 129 real plomb(klon,klev) 130 !! RomP <<< 120 131 ! -------------------------------------------- 121 132 ! Allocation … … 148 159 149 160 lessivage = .TRUE. 161 !!jyg(20130206) : le choix d activation du lessivage est fait dans phytrac avec iflag_lscav 162 !! call getin('lessivage',lessivage) 163 !! if(lessivage) then 164 !! print*,'lessivage lsc ON' 165 !! else 166 !! print*,'lessivage lsc OFF' 167 !! endif 150 168 aerosol(:) = .FALSE. ! Tous les traceurs sont des gaz par defaut 151 169 … … 161 179 ELSE IF ( tname(iiq) == "PB") THEN 162 180 id_pb=it ! plomb 181 ! RomP >>> profil initial de PB210 182 open (ilesfil2,file='prof.pb210',status='old',iostat=irr2) 183 IF (irr2 == 0) THEN 184 read(ilesfil2,*) kradio2 185 print*,'number of levels for pb210 profile ',kradio2 186 do k=kradio2,1,-1 187 read (ilesfil2,*) plomb(:,k) 188 enddo 189 close(ilesfil2) 190 do k=1,klev 191 do i=1,klon 192 tr_seri(i,k,id_pb)=plomb(i,k) 193 !! print*, 'tr_seri',i,k,tr_seri(i,k,id_pb) 194 enddo 195 enddo 196 ELSE 197 print *, 'Prof.pb210 does not exist: use restart values' 198 ENDIF 199 ! RomP <<< 163 200 ELSE IF ( tname(iiq) == "Aga" .OR. tname(iiq) == "AGA" ) THEN 164 201 ! Age of stratospheric air … … 183 220 radio(id_be) = .TRUE. 184 221 aerosol(id_be) = .TRUE. ! le Be est un aerosol 185 CALL init_be(pctsrf,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe) 222 !jyg le 13/03/2013 ; ajout de pplay en argument de init_be 223 !!! CALL init_be(pctsrf,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe) 224 CALL init_be(pctsrf,pplay,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe) 186 225 WRITE(lunout,*) 'Initialisation srcBe: OK' 226 ! RomP >>> profil initial de Be7 227 open (ilesfil,file='prof.be7',status='old',iostat=irr) 228 IF (irr == 0) THEN 229 read(ilesfil,*) kradio 230 print*,'number of levels for Be7 profile ',kradio 231 do k=kradio,1,-1 232 read (ilesfil,*) beryllium(:,k) 233 enddo 234 close(ilesfil) 235 do k=1,klev 236 do i=1,klon 237 tr_seri(i,k,id_be)=beryllium(i,k) 238 !! print*, 'tr_seri',i,k,tr_seri(i,k,id_be) 239 enddo 240 enddo 241 ELSE 242 print *, 'Prof.Be7 does not exist: use restart values' 243 ENDIF 244 ! RomP <<< 187 245 ELSE IF (tname(iiq)=="O3" .OR. tname(iiq)=="o3") THEN 188 246 ! Recherche de l'ozone : parametrization de la chimie par Cariolle … … 280 338 cdragh, coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon, couchelimite, sh, & 281 339 rh, pphi, ustar, zu10m, zv10m, & 282 tr_seri, source, solsym, d_tr_cl, zmasse) 340 !! tr_seri, source, solsym, d_tr_cl, zmasse) !RomP 341 tr_seri, source, solsym, d_tr_cl,d_tr_dec, zmasse) !RomP 283 342 284 343 USE dimphy … … 316 375 !-------------- 317 376 ! 318 REAL,DIMENSION(klon),INTENT(IN) :: cdragh ! coeff drag pour T et Q319 REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh ! diffusivite turb(m**2/s)320 REAL,DIMENSION(klon),INTENT(IN) :: yu1 ! vents au premier niveau321 REAL,DIMENSION(klon),INTENT(IN) :: yv1 ! vents au premier niveau377 REAL,DIMENSION(klon),INTENT(IN) :: cdragh ! coeff drag pour T et Q 378 REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh ! coeff melange CL (m**2/s) 379 REAL,DIMENSION(klon),INTENT(IN) :: yu1 ! vents au premier niveau 380 REAL,DIMENSION(klon),INTENT(IN) :: yv1 ! vents au premier niveau 322 381 LOGICAL,INTENT(IN) :: couchelimite 323 REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique382 REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique 324 383 REAL,DIMENSION(klon,klev),INTENT(IN) :: rh ! Humidite relative 325 384 REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi ! geopotentie -
LMDZ5/branches/testing/libf/phylmd/write_histrac.h
r1665 r1750 10 10 CALL histwrite_phy(nid_tra,.FALSE.,"aire",itau_w,airephy) 11 11 CALL histwrite_phy(nid_tra,.FALSE.,"zmasse",itau_w,zmasse) 12 ! RomP >>> 13 CALL histwrite_phy(nid_tra,.FALSE.,"sourceBE",itau_w,sourceBE) 14 ! RomP <<< 12 15 13 16 !TRACEURS … … 20 23 21 24 ! TD LESSIVAGE 22 IF (lessivage .AND. aerosol(it)) THEN 23 CALL histwrite_phy(nid_tra,.FALSE.,"fl"//tname(iiq),itau_w,flestottr(:,:,it)) 25 IF (lessivage .AND. aerosol(it)) THEN 26 CALL histwrite_phy(nid_tra,.FALSE.,"fl"//tname(iiq),itau_w,flestottr(:,:,it)) 27 CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_ls_"//tname(iiq),itau_w,d_tr_ls(:,:,it)) 28 IF(iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) then 29 CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_insc_"//tname(iiq),itau_w,d_tr_insc(:,:,it)) 30 CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_bcscav_"//tname(iiq),itau_w,d_tr_bcscav(:,:,it)) 31 CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_evls_"//tname(iiq),itau_w,d_tr_evapls(:,:,it)) 32 CALL histwrite_phy(nid_tra,.FALSE.,"qpr_ls_"//tname(iiq),itau_w,qPrls(:,it)) 24 33 ENDIF 34 ENDIF 25 35 26 36 ! TD THERMIQUES … … 35 45 36 46 ! TD COUCHE-LIMITE 47 IF (couchelimite) THEN 37 48 CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_cl_"//tname(iiq),itau_w,d_tr_cl(:,:,it)) 49 CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_dry_"//tname(iiq),itau_w,d_tr_dry(:,it)) 50 CALL histwrite_phy(nid_tra,.FALSE.,"flux_tr_dry_"//tname(iiq),itau_w,flux_tr_dry(:,it)) 51 ENDIF 52 53 ! TD radio-decroissance 54 CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_dec_"//tname(iiq),itau_w,d_tr_dec(:,:,it)) 55 56 ! RomP >>> 57 IF (iflag_con.EQ.30) THEN 58 CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_cvMA_"//tname(iiq),itau_w,dtrcvMA(:,:,it)) 59 CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_trsp_"//tname(iiq),itau_w,d_tr_trsp(:,:,it)) 60 CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_sscav_"//tname(iiq),itau_w,d_tr_sscav(:,:,it)) 61 CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_sat_"//tname(iiq),itau_w,d_tr_sat(:,:,it)) 62 CALL histwrite_phy(nid_tra,.FALSE.,"d_tr_uscav_"//tname(iiq),itau_w,d_tr_uscav(:,:,it)) 63 CALL histwrite_phy(nid_tra,.FALSE.,"tr_pr_"//tname(iiq),itau_w,qPr(:,:,it)) 64 CALL histwrite_phy(nid_tra,.FALSE.,"tr_aa_"//tname(iiq),itau_w,qPa(:,:,it)) 65 CALL histwrite_phy(nid_tra,.FALSE.,"tr_mel_"//tname(iiq),itau_w,qMel(:,:,it)) 66 CALL histwrite_phy(nid_tra,.FALSE.,"tr_di_"//tname(iiq),itau_w,qDi(:,:,it)) 67 CALL histwrite_phy(nid_tra,.FALSE.,"tr_trspdi_"//tname(iiq),itau_w,qTrdi(:,:,it)) 68 CALL histwrite_phy(nid_tra,.FALSE.,"zmfd1a_"//tname(iiq),itau_w,zmfd1a(:,:,it)) 69 CALL histwrite_phy(nid_tra,.FALSE.,"zmfphi2_"//tname(iiq),itau_w,zmfphi2(:,:,it)) 70 CALL histwrite_phy(nid_tra,.FALSE.,"zmfdam_"//tname(iiq),itau_w,zmfdam(:,:,it)) 71 ENDIF 72 CALL histwrite_phy(nid_tra,.FALSE.,"dtrdyn_"//tname(iiq),itau_w,d_tr_dyn(:,:,it)) 73 ! RomP <<< 38 74 ENDDO 39 75 !--------------- … … 65 101 66 102 ! DIVERS 103 CALL histwrite_phy(nid_tra,.FALSE.,"Mint",itau_w,Mint(:,:)) 104 CALL histwrite_phy(nid_tra,.FALSE.,"frac_impa",itau_w,frac_impa(:,:)) 105 CALL histwrite_phy(nid_tra,.FALSE.,"frac_nucl",itau_w,frac_nucl(:,:)) 106 107 67 108 CALL histwrite_phy(nid_tra,.FALSE.,"pplay",itau_w,pplay) 68 109 CALL histwrite_phy(nid_tra,.FALSE.,"T",itau_w,t_seri) -
LMDZ5/branches/testing/libf/phylmd/yamada4.F
r1403 r1750 37 37 c iflag_pbl=6 : MY 2.0 38 38 c iflag_pbl=7 : MY 2.0.Fournier 39 c iflag_pbl=8 : MY 2.5 40 c iflag_pbl>=9 : MY 2.5 avec diffusion verticale 41 42 c....................................................................... 39 c iflag_pbl=8/9 : MY 2.5 40 c iflag_pbl=8 with special obsolete treatments for convergence 41 c with Cmpi5 NPv3.1 simulations 42 c iflag_pbl=10/11 : New scheme M2 and N2 explicit and dissiptation exact 43 c iflag_pbl=12 = 11 with vertical diffusion off q2 44 c 45 c 2013/04/01 (FH hourdin@lmd.jussieu.fr) 46 c Correction for very stable PBLs (iflag_pbl=10 and 11) 47 c iflag_pbl=8 converges numerically with NPv3.1 48 c iflag_pbl=11 -> the model starts with NP from start files created by ce0l 49 c -> the model can run with longer time-steps. 50 c....................................................................... 51 43 52 REAL dt,g,rconst 44 53 real plev(klon,klev+1),temp(klon,klev) … … 63 72 real aa(klon,klev+1),aa0,aa1 64 73 integer iflag_pbl,ngrid 65 66 67 74 integer nlay,nlev 68 75 … … 118 125 119 126 120 if (.not.(iflag_pbl.ge.6.and.iflag_pbl.le.1 0)) then127 if (.not.(iflag_pbl.ge.6.and.iflag_pbl.le.12)) then 121 128 stop'probleme de coherence dans appel a MY' 122 129 endif 123 130 124 131 ipas=ipas+1 125 if (0.eq.1.and.first) then 126 do ig=1,1000 127 ri=(ig-800.)/500. 128 if (ri.lt.ric) then 129 zrif=frif(ri) 130 else 131 zrif=rifc 132 endif 133 if(zrif.lt.0.16) then 134 zalpha=falpha(zrif) 135 zsm=fsm(zrif) 136 else 137 zalpha=1.12 138 zsm=0.085 139 endif 140 c print*,ri,rif,zalpha,zsm 141 enddo 142 endif 132 143 133 144 134 c....................................................................... … … 173 163 ENDDO 174 164 c 175 c....................................................................... 165 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 166 ! Computing M^2, N^2, Richardson numbers, stability functions 167 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 176 168 177 169 do k=2,klev … … 197 189 endif 198 190 zz(ig,k)=b1*m2(ig,k)*(1.-rif(ig,k))*sm(ig,k) 199 c print*,'RIF L=',k,rif(ig,k),ri*alpha(ig,k) 200 201 202 enddo 203 enddo 204 205 206 c==================================================================== 207 c Au premier appel, on determine l et q2 de facon iterative. 208 c iterration pour determiner la longueur de melange 209 210 211 if (first.or.iflag_pbl.eq.6) then 212 do ig=1,ngrid 213 l0(ig)=10. 214 enddo 215 do k=2,klev-1 216 do ig=1,ngrid 217 l(ig,k)=l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig)) 218 enddo 219 enddo 220 221 do iter=1,10 222 do ig=1,ngrid 223 sq(ig)=1.e-10 224 sqz(ig)=1.e-10 225 enddo 226 do k=2,klev-1 227 do ig=1,ngrid 228 q2(ig,k)=l(ig,k)**2*zz(ig,k) 229 l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k)) 230 zq=sqrt(q2(ig,k)) 231 sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1)) 232 sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1)) 233 enddo 234 enddo 235 do ig=1,ngrid 236 l0(ig)=0.2*sqz(ig)/sq(ig) 237 c l0(ig)=30. 238 enddo 239 c print*,'ITER=',iter,' L0=',l0 240 241 enddo 242 243 c print*,'Fin de l initialisation de q2 et l0' 244 245 endif ! first 246 247 c==================================================================== 248 c Calcul de la longueur de melange. 191 enddo 192 enddo 193 194 195 c==================================================================== 196 c Computing the mixing length 249 197 c==================================================================== 250 198 251 199 c Mise a jour de l0 200 if (iflag_pbl==8.or.iflag_pbl==10) then 201 202 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 203 ! Iterative computation of l0 204 ! This version is kept for iflag_pbl only for convergence 205 ! with NPv3.1 Cmip5 simulations 206 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 207 252 208 do ig=1,ngrid 253 209 sq(ig)=1.e-10 … … 263 219 do ig=1,ngrid 264 220 l0(ig)=0.2*sqz(ig)/sq(ig) 265 c l0(ig)=30. 266 enddo 267 c print*,'ITER=',iter,' L0=',l0 268 c calcul de l(z) 221 enddo 269 222 do k=2,klev 270 223 do ig=1,ngrid 271 224 l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k)) 272 if(first) then 273 q2(ig,k)=l(ig,k)**2*zz(ig,k) 274 endif 275 enddo 276 enddo 225 enddo 226 enddo 227 ! print*,'L0 cas 8 ou 10 ',l0 228 229 else 230 231 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 232 ! In all other case, the assymptotic mixing length l0 is imposed (100m) 233 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 234 235 l0(:)=150. 236 do k=2,klev 237 do ig=1,ngrid 238 l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k)) 239 enddo 240 enddo 241 ! print*,'L0 cas autres ',l0 242 243 endif 244 277 245 278 246 c==================================================================== … … 282 250 283 251 do k=2,klev 284 do ig=1,ngrid 285 q2(ig,k)=l(ig,k)**2*zz(ig,k) 286 enddo 252 q2(:,k)=l(:,k)**2*zz(:,k) 287 253 enddo 288 254 … … 342 308 enddo 343 309 344 else if (iflag_pbl .ge.8) then310 else if (iflag_pbl==8.or.iflag_pbl==9) then 345 311 c==================================================================== 346 312 c Yamada 2.5 a la Didi … … 366 332 c print*,'0L=',k,l(ig,k),delta(ig,k),km(ig,k) 367 333 qpre=sqrt(q2(ig,k)) 368 334 ! if (iflag_pbl.eq.8 ) then 369 335 if (aa(ig,k).gt.0.) then 370 336 q2(ig,k)=(qpre+aa(ig,k)*qpre*qpre)**2 … … 372 338 q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2 373 339 endif 374 375 376 377 378 379 380 340 ! else ! iflag_pbl=9 341 ! if (aa(ig,k)*qpre.gt.0.9) then 342 ! q2(ig,k)=(qpre*10.)**2 343 ! else 344 ! q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2 345 ! endif 346 ! endif 381 347 q2(ig,k)=min(max(q2(ig,k),1.e-10),1.e4) 382 348 c print*,'Q2 L=',k,q2(ig,k),qpre*qpre 383 349 enddo 384 350 enddo 351 352 else if (iflag_pbl>=10) then 353 354 ! print*,'Schema mixte D' 355 ! print*,'Longueur ',l(:,:) 356 do k=2,klev-1 357 l(:,k)=max(l(:,k),1.) 358 km(:,k)=l(:,k)*sqrt(q2(:,k))*sm(:,k) 359 q2(:,k)=q2(:,k)+dt*km(:,k)*m2(:,k)*(1.-rif(:,k)) 360 q2(:,k)=min(max(q2(:,k),1.e-10),1.e4) 361 q2(:,k)=1./(1./sqrt(q2(:,k))+dt/(2*l(:,k)*b1)) 362 q2(:,k)=q2(:,k)*q2(:,k) 363 enddo 364 365 366 else 367 stop'Cas nom prevu dans yamada4' 385 368 386 369 endif ! Fin du cas 8 … … 404 387 405 388 ! Transport diffusif vertical de la TKE. 406 if (iflag_pbl.ge. 9) then389 if (iflag_pbl.ge.12) then 407 390 ! print*,'YAMADA VDIF' 408 391 q2(:,1)=q2(:,2) … … 425 408 enddo 426 409 427 ! 410 ! print*,'pblhmin ',pblhmin 428 411 CTest a remettre 21 11 02 429 412 c test abd 13 05 02 if(0.eq.1) then 430 if(1.eq.1) then 413 if(1==1) then 414 if(iflag_pbl==8.or.iflag_pbl==10) then 415 431 416 do k=2,klev 432 417 do ig=1,ngrid … … 449 434 enddo 450 435 enddo 436 437 else 438 439 do k=2,klev 440 do ig=1,ngrid 441 if (teta(ig,2).gt.teta(ig,1)) then 442 qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2 443 kmin=kap*zlev(ig,k)*qmin 444 else 445 kmin=-1. ! kmin n'est utilise que pour les SL stables. 446 endif 447 if (kn(ig,k).lt.kmin.or.km(ig,k).lt.kmin) then 448 c print*,'Seuil min Km K=',k,kmin,km(ig,k),kn(ig,k) 449 c s ,sqrt(q2(ig,k)),pblhmin(ig),qmin/sm(ig,k) 450 kn(ig,k)=kmin 451 km(ig,k)=kmin 452 kq(ig,k)=kmin 453 c la longueur de melange est suposee etre l= kap z 454 c K=l q Sm d'ou q2=(K/l Sm)**2 455 sm(ig,k)=1. 456 alpha(ig,k)=1. 457 q2(ig,k)=min((qmin/sm(ig,k))**2,10.) 458 zq=sqrt(q2(ig,k)) 459 km(ig,k)=l(ig,k)*zq*sm(ig,k) 460 kn(ig,k)=km(ig,k)*alpha(ig,k) 461 kq(ig,k)=l(ig,k)*zq*0.2 462 endif 463 enddo 464 enddo 465 endif 466 451 467 endif 452 468 -
LMDZ5/branches/testing/tools/install_1d_src.sh
-
Property
svn:executable
set to
*
r1707 r1750 59 59 ln -s ../dyn3d/infotrac.F90 . 60 60 ln -s ../dyn3d/conf_gcm.F . 61 ln -s ../dyn3d/pres2lev .F90.61 ln -s ../dyn3d/pres2lev* . 62 62 ln -s ../dyn3d/control_mod.F90 . 63 63 ln -s ../dyn3d/q_sat.F . -
Property
svn:executable
set to
Note: See TracChangeset
for help on using the changeset viewer.
