Changeset 1862
- Timestamp:
- Sep 10, 2013, 2:18:14 PM (11 years ago)
- Location:
- LMDZ5/trunk/libf/phylmd
- Files:
-
- 8 edited
- 1 moved
-
calcul_STDlev.h (modified) (15 diffs)
-
calcul_divers.h (modified) (2 diffs)
-
declare_STDlev.h (modified) (3 diffs)
-
ini_histday_seri.h (modified) (2 diffs)
-
ini_paramLMDZ_phy.h (modified) (3 diffs)
-
physiq.F90 (moved) (moved from LMDZ5/trunk/libf/phylmd/physiq.F) (149 diffs)
-
regdim.h (modified) (1 diff)
-
write_histday_seri.h (modified) (4 diffs)
-
write_paramLMDZ_phy.h (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/calcul_STDlev.h
r1694 r1862 1 c 2 c$Header$3 c 4 cIM on initialise les variables5 c 1 ! 2 ! $Header$ 3 ! 4 !IM on initialise les variables 5 ! 6 6 missing_val=nf90_fill_real 7 c 8 cIM freq_moyNMC = frequences auxquelles on moyenne les champs accumules9 cIM sur les niveaux de pression standard du NMC7 ! 8 !IM freq_moyNMC = frequences auxquelles on moyenne les champs accumules 9 !IM sur les niveaux de pression standard du NMC 10 10 DO n=1, nout 11 11 freq_moyNMC(n)=freq_outNMC(n)/freq_calNMC(n) 12 12 ENDDO 13 c 13 ! 14 14 CALL ini_undefSTD(itap,freq_outNMC) 15 c 16 cIM on interpole les champs sur les niveaux STD de pression17 cIM a chaque pas de temps de la physique18 c 19 c-------------------------------------------------------c20 cpositionnement de l'argument logique a .false. c21 cpour ne pas recalculer deux fois la meme chose ! c22 ca cet effet un appel a plevel_new a ete deplace c23 ca la fin de la serie d'appels c24 cla boucle 'DO k=1, nlevSTD' a ete internalisee c25 cdans plevel_new, d'ou la creation de cette routine... c26 c-------------------------------------------------------c27 c 28 CALL plevel_new(klon,klev,nlevSTD,.true.,pplay,rlevSTD, 29 &t_seri,tlevSTD)30 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 31 &u_seri,ulevSTD)32 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 33 &v_seri,vlevSTD)34 c 35 36 c 37 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 38 &zphi/RG,philevSTD)39 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 40 &qx(:,:,ivap),qlevSTD)41 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 42 &zx_rh*100.,rhlevSTD)43 c 15 ! 16 !IM on interpole les champs sur les niveaux STD de pression 17 !IM a chaque pas de temps de la physique 18 ! 19 !-------------------------------------------------------c 20 ! positionnement de l'argument logique a .false. c 21 ! pour ne pas recalculer deux fois la meme chose ! c 22 ! a cet effet un appel a plevel_new a ete deplace c 23 ! a la fin de la serie d'appels c 24 ! la boucle 'DO k=1, nlevSTD' a ete internalisee c 25 ! dans plevel_new, d'ou la creation de cette routine... c 26 !-------------------------------------------------------c 27 ! 28 CALL plevel_new(klon,klev,nlevSTD,.true.,pplay,rlevSTD, & 29 t_seri,tlevSTD) 30 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 31 u_seri,ulevSTD) 32 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 33 v_seri,vlevSTD) 34 ! 35 36 ! 37 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 38 zphi/RG,philevSTD) 39 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 40 qx(:,:,ivap),qlevSTD) 41 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 42 zx_rh*100.,rhlevSTD) 43 ! 44 44 DO l=1, klev 45 45 DO i=1, klon … … 47 47 ENDDO !i 48 48 ENDDO !l 49 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 50 &zx_tmp_fi3d,uvSTD)51 c 49 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 50 zx_tmp_fi3d,uvSTD) 51 ! 52 52 DO l=1, klev 53 53 DO i=1, klon … … 55 55 ENDDO !i 56 56 ENDDO !l 57 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 58 &zx_tmp_fi3d,vqSTD)59 c 57 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 58 zx_tmp_fi3d,vqSTD) 59 ! 60 60 DO l=1, klev 61 61 DO i=1, klon … … 63 63 ENDDO !i 64 64 ENDDO !l 65 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 66 &zx_tmp_fi3d,vTSTD)67 c 65 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 66 zx_tmp_fi3d,vTSTD) 67 ! 68 68 DO l=1, klev 69 69 DO i=1, klon … … 71 71 ENDDO !i 72 72 ENDDO !l 73 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 74 &zx_tmp_fi3d,wqSTD)75 c 73 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 74 zx_tmp_fi3d,wqSTD) 75 ! 76 76 DO l=1, klev 77 77 DO i=1, klon … … 79 79 ENDDO !i 80 80 ENDDO !l 81 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 82 &zx_tmp_fi3d,vphiSTD)83 c 81 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 82 zx_tmp_fi3d,vphiSTD) 83 ! 84 84 DO l=1, klev 85 85 DO i=1, klon … … 87 87 ENDDO !i 88 88 ENDDO !l 89 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 90 &zx_tmp_fi3d,wTSTD)91 c 89 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 90 zx_tmp_fi3d,wTSTD) 91 ! 92 92 DO l=1, klev 93 93 DO i=1, klon … … 95 95 ENDDO !i 96 96 ENDDO !l 97 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 98 &zx_tmp_fi3d,u2STD)99 c 97 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 98 zx_tmp_fi3d,u2STD) 99 ! 100 100 DO l=1, klev 101 101 DO i=1, klon … … 103 103 ENDDO !i 104 104 ENDDO !l 105 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 106 &zx_tmp_fi3d,v2STD)107 c 105 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 106 zx_tmp_fi3d,v2STD) 107 ! 108 108 DO l=1, klev 109 109 DO i=1, klon … … 111 111 ENDDO !i 112 112 ENDDO !l 113 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 114 &zx_tmp_fi3d,T2STD)115 116 c 113 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 114 zx_tmp_fi3d,T2STD) 115 116 ! 117 117 zx_tmp_fi3d(:,:)=wo(:,:,1) * dobson_u * 1e3 / zmasse / rmo3 * rmd 118 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 119 &zx_tmp_fi3d,O3STD)120 c 118 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 119 zx_tmp_fi3d,O3STD) 120 ! 121 121 if (read_climoz == 2) THEN 122 122 zx_tmp_fi3d(:,:)=wo(:,:,2) * dobson_u * 1e3 / zmasse / rmo3 * rmd 123 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, 124 &zx_tmp_fi3d,O3daySTD)123 CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD, & 124 zx_tmp_fi3d,O3daySTD) 125 125 endif 126 c 126 ! 127 127 DO l=1, klev 128 128 DO i=1, klon … … 130 130 ENDDO !i 131 131 ENDDO !l 132 CALL plevel_new(klon,klev,nlevSTD,.true.,zx_tmp_fi3d,rlevSTD, 133 &omega,wlevSTD)134 c 135 cIM on somme les valeurs toutes les freq_calNMC secondes136 c 132 CALL plevel_new(klon,klev,nlevSTD,.true.,zx_tmp_fi3d,rlevSTD, & 133 omega,wlevSTD) 134 ! 135 !IM on somme les valeurs toutes les freq_calNMC secondes 136 ! 137 137 CALL undefSTD(itap,freq_calNMC, read_climoz) 138 c 139 cIM on moyenne a la fin du mois ou du jour (toutes les freq_outNMC secondes)140 c 138 ! 139 !IM on moyenne a la fin du mois ou du jour (toutes les freq_outNMC secondes) 140 ! 141 141 CALL moy_undefSTD(itap,freq_outNMC,freq_moyNMC) 142 c 143 CALL plevel(klon,klev,.true.,pplay,50000., 144 &zphi/RG,geo500)145 146 cIM on interpole a chaque pas de temps le SWup(clr) et SWdn(clr) a 200 hPa147 c 148 CALL plevel(klon,klevp1,.true.,paprs,20000., 149 $swdn0,SWdn200clr)150 CALL plevel(klon,klevp1,.false.,paprs,20000., 151 $swdn,SWdn200)152 CALL plevel(klon,klevp1,.false.,paprs,20000., 153 $swup0,SWup200clr)154 CALL plevel(klon,klevp1,.false.,paprs,20000., 155 $swup,SWup200)156 c 157 CALL plevel(klon,klevp1,.false.,paprs,20000., 158 $lwdn0,LWdn200clr)159 CALL plevel(klon,klevp1,.false.,paprs,20000., 160 $lwdn,LWdn200)161 CALL plevel(klon,klevp1,.false.,paprs,20000., 162 $lwup0,LWup200clr)163 CALL plevel(klon,klevp1,.false.,paprs,20000., 164 $lwup,LWup200)165 c 142 ! 143 CALL plevel(klon,klev,.true.,pplay,50000., & 144 zphi/RG,geo500) 145 146 !IM on interpole a chaque pas de temps le SWup(clr) et SWdn(clr) a 200 hPa 147 ! 148 CALL plevel(klon,klevp1,.true.,paprs,20000., & 149 swdn0,SWdn200clr) 150 CALL plevel(klon,klevp1,.false.,paprs,20000., & 151 swdn,SWdn200) 152 CALL plevel(klon,klevp1,.false.,paprs,20000., & 153 swup0,SWup200clr) 154 CALL plevel(klon,klevp1,.false.,paprs,20000., & 155 swup,SWup200) 156 ! 157 CALL plevel(klon,klevp1,.false.,paprs,20000., & 158 lwdn0,LWdn200clr) 159 CALL plevel(klon,klevp1,.false.,paprs,20000., & 160 lwdn,LWdn200) 161 CALL plevel(klon,klevp1,.false.,paprs,20000., & 162 lwup0,LWup200clr) 163 CALL plevel(klon,klevp1,.false.,paprs,20000., & 164 lwup,LWup200) 165 ! 166 166 twriteSTD(:,:,1)=tsumSTD(:,:,1) 167 167 qwriteSTD(:,:,1)=qsumSTD(:,:,1) … … 195 195 vwriteSTD(:,:,4)=vlevSTD(:,:) 196 196 wwriteSTD(:,:,4)=wlevSTD(:,:) 197 c 198 cIM initialisation 5eme fichier de sortie197 ! 198 !IM initialisation 5eme fichier de sortie 199 199 twriteSTD(:,:,5)=tlevSTD(:,:) 200 200 qwriteSTD(:,:,5)=qlevSTD(:,:) … … 204 204 vwriteSTD(:,:,5)=vlevSTD(:,:) 205 205 wwriteSTD(:,:,5)=wlevSTD(:,:) 206 c 207 cIM initialisation 6eme fichier de sortie206 ! 207 !IM initialisation 6eme fichier de sortie 208 208 twriteSTD(:,:,6)=tlevSTD(:,:) 209 209 qwriteSTD(:,:,6)=qlevSTD(:,:) … … 213 213 vwriteSTD(:,:,6)=vlevSTD(:,:) 214 214 wwriteSTD(:,:,6)=wlevSTD(:,:) 215 cIM for NMC files215 !IM for NMC files 216 216 DO n=1, nlevSTD3 217 217 DO k=1, nlevSTD … … 227 227 ENDDO 228 228 ENDDO 229 c 229 ! 230 230 DO n=1, nlevSTD8 231 231 DO k=1, nlevSTD -
LMDZ5/trunk/libf/phylmd/calcul_divers.h
r1454 r1862 1 c 2 c$Header$3 c 1 ! 2 ! $Header$ 3 ! 4 4 5 cInitialisations diverses au "debut" du mois5 ! Initialisations diverses au "debut" du mois 6 6 IF(debut) THEN 7 7 nday_rain(:)=0. 8 8 9 csurface terre9 ! surface terre 10 10 paire_ter(:)=0. 11 11 DO i=1, klon … … 16 16 ENDIF 17 17 18 cIM Calcul une fois par jour : total_rain, nday_rain18 !IM Calcul une fois par jour : total_rain, nday_rain 19 19 IF(MOD(itap,INT(un_jour/dtime)).EQ.0) THEN 20 20 DO i = 1, klon -
LMDZ5/trunk/libf/phylmd/declare_STDlev.h
r1828 r1862 1 cIM for NMC files1 !IM for NMC files 2 2 ! real twriteSTD(klon,nlevSTD,nfiles) 3 3 ! real qwriteSTD(klon,nlevSTD,nfiles) … … 26 26 27 27 real, save :: rlevSTD(nlevSTD) 28 DATA rlevSTD/100000., 92500., 85000., 70000., 29 .60000., 50000., 40000., 30000., 25000., 20000.,30 .15000., 10000., 7000., 5000., 3000., 2000., 1000./31 c$OMP THREADPRIVATE(rlevstd)28 DATA rlevSTD/100000., 92500., 85000., 70000., & 29 60000., 50000., 40000., 30000., 25000., 20000., & 30 15000., 10000., 7000., 5000., 3000., 2000., 1000./ 31 !$OMP THREADPRIVATE(rlevstd) 32 32 33 33 CHARACTER*4, SAVE :: clevSTD(nlevSTD) 34 DATA clevSTD/'1000','925 ','850 ','700 ','600 ', 35 .'500 ','400 ','300 ','250 ','200 ','150 ','100 ',36 .'70 ','50 ','30 ','20 ','10 '/37 c$OMP THREADPRIVATE(clevSTD)34 DATA clevSTD/'1000','925 ','850 ','700 ','600 ', & 35 '500 ','400 ','300 ','250 ','200 ','150 ','100 ', & 36 '70 ','50 ','30 ','20 ','10 '/ 37 !$OMP THREADPRIVATE(clevSTD) 38 38 39 39 real, save :: rlevSTD3(nlevSTD3) 40 40 DATA rlevSTD3/85000., 50000., 25000./ 41 c$OMP THREADPRIVATE(rlevSTD3)41 !$OMP THREADPRIVATE(rlevSTD3) 42 42 43 43 real, save :: rlevSTD8(nlevSTD8) 44 DATA rlevSTD8/100000., 85000., 70000., 50000., 25000., 10000., 45 $5000., 1000./46 c$OMP THREADPRIVATE(rlevSTD8)47 c 44 DATA rlevSTD8/100000., 85000., 70000., 50000., 25000., 10000., & 45 5000., 1000./ 46 !$OMP THREADPRIVATE(rlevSTD8) 47 ! 48 48 REAL geo500(klon) 49 49 50 cnout : niveau de output des variables a une pression donnee50 ! nout : niveau de output des variables a une pression donnee 51 51 logical oknondef(klon,nlevSTD,nout) 52 c 53 cles produits uvSTD, vqSTD, .., T2STD sont calcules54 ca partir des valeurs instantannees toutes les 6 h55 cqui sont moyennees sur le mois52 ! 53 ! les produits uvSTD, vqSTD, .., T2STD sont calcules 54 ! a partir des valeurs instantannees toutes les 6 h 55 ! qui sont moyennees sur le mois 56 56 57 57 REAL zx_tmp_fiNC(klon,nlevSTD) … … 59 59 REAL missing_val 60 60 REAL, SAVE :: freq_moyNMC(nout) 61 c$OMP THREADPRIVATE(freq_moyNMC)61 !$OMP THREADPRIVATE(freq_moyNMC) -
LMDZ5/trunk/libf/phylmd/ini_histday_seri.h
r1403 r1862 1 c 2 c$Id$3 c 4 cym Ne fonctionnera pas en mode parallele1 ! 2 ! $Id$ 3 ! 4 !ym Ne fonctionnera pas en mode parallele 5 5 IF (is_sequential) THEN 6 6 7 7 IF (type_run.EQ."AMIP") THEN 8 c 8 ! 9 9 zstophy = dtime 10 10 zout = ecrit_day 11 c 11 ! 12 12 idayref = day_ref 13 13 CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) 14 c 14 ! 15 15 CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon) 16 16 DO i = 1, iim … … 22 22 ENDDO 23 23 CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat) 24 c 24 ! 25 25 imin_debut=1 26 26 nbpti=1 27 27 jmin_debut=1 28 28 nbptj=1 29 c 30 CALL histbeg("histday_seri.nc", 31 . iim,zx_lon(:,1), jjmp1,zx_lat(1,:),32 . imin_debut,nbpti,jmin_debut,nbptj,33 . itau_phy, zjulian, dtime,34 .nhori, nid_day_seri)35 c 36 CALL histvert(nid_day_seri, "presnivs", 37 . "Vertical levels","mb",38 .klev, presnivs/100., nvert)39 c 40 CALL histdef(nid_day_seri, "bilTOA", 41 . "Net radiation at model top", "W/m2",42 . iim,jjmp1,nhori, 1,1,1, -99, 32,43 ."ave(X)", zstophy,zout)44 c 45 CALL histdef(nid_day_seri, "bils", 46 . "Net downward energy flux at surface","W/m2",47 . iim,jjmp1,nhori, 1,1,1, -99, 32,48 ."ave(X)", zstophy,zout)49 c 50 CALL histdef(nid_day_seri, "ecin", 51 . "Total kinetic energy (per unit area)","J/m2",52 . iim,jjmp1,nhori, 1,1,1, -99, 32,53 ."ave(X)", zstophy,zout)54 c 55 cIM 151004 BEG29 ! 30 CALL histbeg("histday_seri.nc", & 31 iim,zx_lon(:,1), jjmp1,zx_lat(1,:), & 32 imin_debut,nbpti,jmin_debut,nbptj, & 33 itau_phy, zjulian, dtime, & 34 nhori, nid_day_seri) 35 ! 36 CALL histvert(nid_day_seri, "presnivs", & 37 "Vertical levels","mb", & 38 klev, presnivs/100., nvert) 39 ! 40 CALL histdef(nid_day_seri, "bilTOA", & 41 "Net radiation at model top", "W/m2", & 42 iim,jjmp1,nhori, 1,1,1, -99, 32, & 43 "ave(X)", zstophy,zout) 44 ! 45 CALL histdef(nid_day_seri, "bils", & 46 "Net downward energy flux at surface","W/m2", & 47 iim,jjmp1,nhori, 1,1,1, -99, 32, & 48 "ave(X)", zstophy,zout) 49 ! 50 CALL histdef(nid_day_seri, "ecin", & 51 "Total kinetic energy (per unit area)","J/m2", & 52 iim,jjmp1,nhori, 1,1,1, -99, 32, & 53 "ave(X)", zstophy,zout) 54 ! 55 !IM 151004 BEG 56 56 IF(1.EQ.0) THEN 57 c 58 CALL histdef(nid_day_seri, "momang", 59 . "Total relative angular momentum (per unit area)",60 . "kg/s",61 . iim,jjmp1,nhori, 1,1,1, -99, 32,62 ."ave(X)", zstophy,zout)63 c 64 CALL histdef(nid_day_seri, "frictor", 65 . "Friction torque (per unit area)", "N/m",66 . iim,jjmp1,nhori, 1,1,1, -99, 32,67 ."ave(X)", zstophy,zout)68 c 69 CALL histdef(nid_day_seri, "mountor", 70 . "Mountain torque (per unit area)", "N/m",71 . iim,jjmp1,nhori, 1,1,1, -99, 32,72 ."ave(X)", zstophy,zout)73 c 57 ! 58 CALL histdef(nid_day_seri, "momang", & 59 "Total relative angular momentum (per unit area)", & 60 "kg/s", & 61 iim,jjmp1,nhori, 1,1,1, -99, 32, & 62 "ave(X)", zstophy,zout) 63 ! 64 CALL histdef(nid_day_seri, "frictor", & 65 "Friction torque (per unit area)", "N/m", & 66 iim,jjmp1,nhori, 1,1,1, -99, 32, & 67 "ave(X)", zstophy,zout) 68 ! 69 CALL histdef(nid_day_seri, "mountor", & 70 "Mountain torque (per unit area)", "N/m", & 71 iim,jjmp1,nhori, 1,1,1, -99, 32, & 72 "ave(X)", zstophy,zout) 73 ! 74 74 ENDIF !(1.EQ.0) THEN 75 c 76 CALL histdef(nid_day_seri, "momang", 77 . "Axial angular momentum (per unit area)",78 . "kg/s",79 . iim,jjmp1,nhori, 1,1,1, -99, 32,80 ."ave(X)", zstophy,zout)81 c 82 CALL histdef(nid_day_seri, "torsfc", 83 . "Total surface torque (including mountain torque)", "N/m",84 . iim,jjmp1,nhori, 1,1,1, -99, 32,85 ."ave(X)", zstophy,zout)86 c 87 cIM 151004 END88 c 89 CALL histdef(nid_day_seri, "tamv", 90 . "Temperature (mass-weighted vert. ave)", "K",91 . iim,jjmp1,nhori, 1,1,1, -99, 32,92 ."ave(X)", zstophy,zout)93 c 94 CALL histdef(nid_day_seri, "psol", 95 . "Surface pressure", "Pa",96 . iim,jjmp1,nhori, 1,1,1, -99, 32,97 ."ave(X)", zstophy,zout)98 c 99 CALL histdef(nid_day_seri, "evap", 100 . "Evaporation and sublimation (per unit area)",101 . "kg/(m2*s)",102 . iim,jjmp1,nhori, 1,1,1, -99, 32,103 ."ave(X)", zstophy,zout)104 c 105 ccall histdef(nid_day_seri,106 c. "SnowFrac",107 c. "Snow-covered area ", "%",108 c. iim,jjmp1,nhori, 1,1,1, -99, 32,109 c. "ave(X)", zstophy,zout)110 c 111 cCALL histdef(nid_day_seri, "snow_depth",112 cIM 080904 . "Snow Depth (water equivalent)", "m",113 cIM 191104 . "Snow Depth (water equivalent)", "kg/m2",114 c. "Snow Mass", "kg/m2",115 c. iim,jjmp1,nhori, 1,1,1, -99, 32,116 c. "ave(X)", zstophy,zout)117 c 118 call histdef(nid_day_seri, 119 . "tsol_"//clnsurf(is_oce),120 . "SST over open (ice-free) ocean ", "K",121 . iim,jjmp1,nhori, 1,1,1, -99, 32,122 ."ave(X)", zstophy,zout)123 c 124 c=================================================================125 c 75 ! 76 CALL histdef(nid_day_seri, "momang", & 77 "Axial angular momentum (per unit area)", & 78 "kg/s", & 79 iim,jjmp1,nhori, 1,1,1, -99, 32, & 80 "ave(X)", zstophy,zout) 81 ! 82 CALL histdef(nid_day_seri, "torsfc", & 83 "Total surface torque (including mountain torque)", "N/m", & 84 iim,jjmp1,nhori, 1,1,1, -99, 32, & 85 "ave(X)", zstophy,zout) 86 ! 87 !IM 151004 END 88 ! 89 CALL histdef(nid_day_seri, "tamv", & 90 "Temperature (mass-weighted vert. ave)", "K", & 91 iim,jjmp1,nhori, 1,1,1, -99, 32, & 92 "ave(X)", zstophy,zout) 93 ! 94 CALL histdef(nid_day_seri, "psol", & 95 "Surface pressure", "Pa", & 96 iim,jjmp1,nhori, 1,1,1, -99, 32, & 97 "ave(X)", zstophy,zout) 98 ! 99 CALL histdef(nid_day_seri, "evap", & 100 "Evaporation and sublimation (per unit area)", & 101 "kg/(m2*s)", & 102 iim,jjmp1,nhori, 1,1,1, -99, 32, & 103 "ave(X)", zstophy,zout) 104 ! 105 ! call histdef(nid_day_seri, 106 ! . "SnowFrac", 107 ! . "Snow-covered area ", "%", 108 ! . iim,jjmp1,nhori, 1,1,1, -99, 32, 109 ! . "ave(X)", zstophy,zout) 110 ! 111 ! CALL histdef(nid_day_seri, "snow_depth", 112 !IM 080904 . "Snow Depth (water equivalent)", "m", 113 !IM 191104 . "Snow Depth (water equivalent)", "kg/m2", 114 ! . "Snow Mass", "kg/m2", 115 ! . iim,jjmp1,nhori, 1,1,1, -99, 32, 116 ! . "ave(X)", zstophy,zout) 117 ! 118 call histdef(nid_day_seri, & 119 "tsol_"//clnsurf(is_oce), & 120 "SST over open (ice-free) ocean ", "K", & 121 iim,jjmp1,nhori, 1,1,1, -99, 32, & 122 "ave(X)", zstophy,zout) 123 ! 124 !================================================================= 125 ! 126 126 CALL histend(nid_day_seri) 127 c 128 c=================================================================127 ! 128 !================================================================= 129 129 ENDIF ! fin de test sur type_run.EQ.AMIP 130 130 -
LMDZ5/trunk/libf/phylmd/ini_paramLMDZ_phy.h
r1538 r1862 1 cIM Implemente en modes sequentiel et parallele1 !IM Implemente en modes sequentiel et parallele 2 2 3 3 CALL gather(rlat,rlat_glo) … … 6 6 CALL bcast(rlon_glo) 7 7 8 c$OMP MASTER8 !$OMP MASTER 9 9 if (is_mpi_root) then 10 c 10 ! 11 11 zstophy = dtime 12 12 zout = mth_len*un_jour 13 c 13 ! 14 14 idayref = day_ref 15 15 CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) 16 c 16 ! 17 17 CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon_glo,zx_lon) 18 18 if (iim.gt.1) then … … 23 23 endif 24 24 CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat_glo,zx_lat) 25 c 26 CALL histbeg("paramLMDZ_phy.nc", 27 . np,zx_lon(np:np,1), np,zx_lat(1,np:np),28 . 1,1,1,1,29 . itau_phy, zjulian, dtime,30 .nhori, nid_ctesGCM)31 c 32 CALL histdef(nid_ctesGCM, "R_ecc", 33 . "Excentricite","-",34 . 1,1,nhori, 1,1,1, -99, 32,35 ."ave", zstophy,zout)36 c 37 CALL histdef(nid_ctesGCM, "R_peri", 38 . "Equinoxe","-",39 . 1,1,nhori, 1,1,1, -99, 32,40 ."ave", zstophy,zout)41 c 42 CALL histdef(nid_ctesGCM, "R_incl", 43 . "Inclinaison","deg",44 . 1,1,nhori, 1,1,1, -99, 32,45 ."ave", zstophy,zout)46 c 47 CALL histdef(nid_ctesGCM, "solaire", 48 . "Constante solaire","W/m2",49 . 1,1,nhori, 1,1,1, -99, 32,50 ."ave", zstophy,zout)51 c 52 CALL histdef(nid_ctesGCM, "co2_ppm", 53 . "Concentration du CO2", "ppm",54 . 1,1,nhori, 1,1,1, -99, 32,55 ."ave(X)", zstophy,zout)56 c 57 CALL histdef(nid_ctesGCM, "CH4_ppb", 58 . "Concentration du CH4", "ppb",59 . 1,1,nhori, 1,1,1, -99, 32,60 ."ave(X)", zstophy,zout)61 c 62 CALL histdef(nid_ctesGCM, "N2O_ppb", 63 . "Concentration du N2O", "ppb",64 . 1,1,nhori, 1,1,1, -99, 32,65 ."ave(X)", zstophy,zout)66 c 67 CALL histdef(nid_ctesGCM, "CFC11_ppt", 68 . "Concentration du CFC11", "ppt",69 . 1,1,nhori, 1,1,1, -99, 32,70 ."ave(X)", zstophy,zout)71 c 72 CALL histdef(nid_ctesGCM, "CFC12_ppt", 73 . "Concentration du CFC12", "ppt",74 . 1,1,nhori, 1,1,1, -99, 32,75 ."ave(X)", zstophy,zout)76 c 77 CALL histdef(nid_ctesGCM, "bils", 78 . "Surface total heat flux", "W m-2",79 . 1,1,nhori, 1,1,1, -99, 32,80 ."ave", zstophy,zout)81 c 82 CALL histdef(nid_ctesGCM, "evap", 83 . "Evaporation", "kg m-2 s-1",84 . 1,1,nhori, 1,1,1, -99, 32,85 ."ave", zstophy,zout)86 c 87 CALL histdef(nid_ctesGCM, "evap_land", 88 . "Land evaporation", "kg m-2 s-1",89 . 1,1,nhori, 1,1,1, -99, 32,90 ."ave", zstophy,zout)91 c 92 CALL histdef(nid_ctesGCM, "flat", 93 . "Latent heat flux", "W m-2",94 . 1,1,nhori, 1,1,1, -99, 32,95 ."ave", zstophy,zout)96 c 97 CALL histdef(nid_ctesGCM, "nettop0", 98 . "Clear sky net downward radiatif flux at TOA",99 . "W m-2",100 . 1,1,nhori, 1,1,1, -99, 32,101 ."ave", zstophy,zout)102 c 103 CALL histdef(nid_ctesGCM, "nettop", 104 . "Net downward radiatif flux at TOA", "W m-2",105 . 1,1,nhori, 1,1,1, -99, 32,106 ."ave", zstophy,zout)107 c 108 CALL histdef(nid_ctesGCM, "precip", 109 . "Total precipitation (liq+sol)", "kg m-2 s-1",110 . 1,1,nhori, 1,1,1, -99, 32,111 ."ave", zstophy,zout)112 c 113 CALL histdef(nid_ctesGCM, "tsol", 114 . "Surface temperature", "K",115 . 1,1,nhori, 1,1,1, -99, 32,116 ."ave", zstophy,zout)117 c 118 CALL histdef(nid_ctesGCM, "t2m", 119 . "Temperature at 2m", "K",120 . 1,1,nhori, 1,1,1, -99, 32,121 ."ave", zstophy,zout)122 c 123 CALL histdef(nid_ctesGCM, "prw", 124 . "Precipitable water", "kg m-2",125 . 1,1,nhori, 1,1,1, -99, 32,126 ."ave", zstophy,zout)127 c=================================================================128 c 25 ! 26 CALL histbeg("paramLMDZ_phy.nc", & 27 np,zx_lon(np:np,1), np,zx_lat(1,np:np), & 28 1,1,1,1, & 29 itau_phy, zjulian, dtime, & 30 nhori, nid_ctesGCM) 31 ! 32 CALL histdef(nid_ctesGCM, "R_ecc", & 33 "Excentricite","-", & 34 1,1,nhori, 1,1,1, -99, 32, & 35 "ave", zstophy,zout) 36 ! 37 CALL histdef(nid_ctesGCM, "R_peri", & 38 "Equinoxe","-", & 39 1,1,nhori, 1,1,1, -99, 32, & 40 "ave", zstophy,zout) 41 ! 42 CALL histdef(nid_ctesGCM, "R_incl", & 43 "Inclinaison","deg", & 44 1,1,nhori, 1,1,1, -99, 32, & 45 "ave", zstophy,zout) 46 ! 47 CALL histdef(nid_ctesGCM, "solaire", & 48 "Constante solaire","W/m2", & 49 1,1,nhori, 1,1,1, -99, 32, & 50 "ave", zstophy,zout) 51 ! 52 CALL histdef(nid_ctesGCM, "co2_ppm", & 53 "Concentration du CO2", "ppm", & 54 1,1,nhori, 1,1,1, -99, 32, & 55 "ave(X)", zstophy,zout) 56 ! 57 CALL histdef(nid_ctesGCM, "CH4_ppb", & 58 "Concentration du CH4", "ppb", & 59 1,1,nhori, 1,1,1, -99, 32, & 60 "ave(X)", zstophy,zout) 61 ! 62 CALL histdef(nid_ctesGCM, "N2O_ppb", & 63 "Concentration du N2O", "ppb", & 64 1,1,nhori, 1,1,1, -99, 32, & 65 "ave(X)", zstophy,zout) 66 ! 67 CALL histdef(nid_ctesGCM, "CFC11_ppt", & 68 "Concentration du CFC11", "ppt", & 69 1,1,nhori, 1,1,1, -99, 32, & 70 "ave(X)", zstophy,zout) 71 ! 72 CALL histdef(nid_ctesGCM, "CFC12_ppt", & 73 "Concentration du CFC12", "ppt", & 74 1,1,nhori, 1,1,1, -99, 32, & 75 "ave(X)", zstophy,zout) 76 ! 77 CALL histdef(nid_ctesGCM, "bils", & 78 "Surface total heat flux", "W m-2", & 79 1,1,nhori, 1,1,1, -99, 32, & 80 "ave", zstophy,zout) 81 ! 82 CALL histdef(nid_ctesGCM, "evap", & 83 "Evaporation", "kg m-2 s-1", & 84 1,1,nhori, 1,1,1, -99, 32, & 85 "ave", zstophy,zout) 86 ! 87 CALL histdef(nid_ctesGCM, "evap_land", & 88 "Land evaporation", "kg m-2 s-1", & 89 1,1,nhori, 1,1,1, -99, 32, & 90 "ave", zstophy,zout) 91 ! 92 CALL histdef(nid_ctesGCM, "flat", & 93 "Latent heat flux", "W m-2", & 94 1,1,nhori, 1,1,1, -99, 32, & 95 "ave", zstophy,zout) 96 ! 97 CALL histdef(nid_ctesGCM, "nettop0", & 98 "Clear sky net downward radiatif flux at TOA", & 99 "W m-2", & 100 1,1,nhori, 1,1,1, -99, 32, & 101 "ave", zstophy,zout) 102 ! 103 CALL histdef(nid_ctesGCM, "nettop", & 104 "Net downward radiatif flux at TOA", "W m-2", & 105 1,1,nhori, 1,1,1, -99, 32, & 106 "ave", zstophy,zout) 107 ! 108 CALL histdef(nid_ctesGCM, "precip", & 109 "Total precipitation (liq+sol)", "kg m-2 s-1", & 110 1,1,nhori, 1,1,1, -99, 32, & 111 "ave", zstophy,zout) 112 ! 113 CALL histdef(nid_ctesGCM, "tsol", & 114 "Surface temperature", "K", & 115 1,1,nhori, 1,1,1, -99, 32, & 116 "ave", zstophy,zout) 117 ! 118 CALL histdef(nid_ctesGCM, "t2m", & 119 "Temperature at 2m", "K", & 120 1,1,nhori, 1,1,1, -99, 32, & 121 "ave", zstophy,zout) 122 ! 123 CALL histdef(nid_ctesGCM, "prw", & 124 "Precipitable water", "kg m-2", & 125 1,1,nhori, 1,1,1, -99, 32, & 126 "ave", zstophy,zout) 127 !================================================================= 128 ! 129 129 CALL histend(nid_ctesGCM) 130 130 131 131 endif !(is_mpi_root) 132 c$OMP END MASTER133 c=================================================================132 !$OMP END MASTER 133 !================================================================= -
LMDZ5/trunk/libf/phylmd/physiq.F90
r1861 r1862 1 1 ! $Id$ 2 c#define IO_DEBUG3 4 SUBROUTINE physiq (nlon,nlev, 5 . debut,lafin,jD_cur, jH_cur,pdtphys,6 . paprs,pplay,pphi,pphis,presnivs,clesphy0,7 . u,v,t,qx,8 . flxmass_w,9 . d_u, d_v, d_t, d_qx, d_ps10 . , dudyn11 ., PVteta)12 13 USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, 14 $histwrite, ju2ymds, ymds2ju, ioget_year_len2 !#define IO_DEBUG 3 4 SUBROUTINE physiq (nlon,nlev, & 5 debut,lafin,jD_cur, jH_cur,pdtphys, & 6 paprs,pplay,pphi,pphis,presnivs,clesphy0, & 7 u,v,t,qx, & 8 flxmass_w, & 9 d_u, d_v, d_t, d_qx, d_ps & 10 , dudyn & 11 , PVteta) 12 13 USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, & 14 histwrite, ju2ymds, ymds2ju, ioget_year_len 15 15 USE comgeomphy 16 16 USE phys_cal_mod … … 37 37 use regr_pr_av_m, only: regr_pr_av 38 38 use netcdf95, only: nf95_close 39 cIM for NMC files40 cuse netcdf, only: nf90_fill_real39 !IM for NMC files 40 ! use netcdf, only: nf90_fill_real 41 41 use netcdf 42 42 use mod_phys_lmdz_mpi_data, only: is_mpi_root … … 69 69 !! ===================== 70 70 #define histNMC 71 c#define histISCCP71 !#define histISCCP 72 72 !!====================================================================== 73 73 !! modif ( P. Le Van , 12/10/98 ) … … 114 114 #include "iniprint.h" 115 115 #include "thermcell.h" 116 c======================================================================116 !====================================================================== 117 117 LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE 118 118 PARAMETER (ok_cvl=.TRUE.) … … 121 121 integer iflag_radia ! active ou non le rayonnement (MPL) 122 122 save iflag_radia 123 c$OMP THREADPRIVATE(iflag_radia)124 c======================================================================123 !$OMP THREADPRIVATE(iflag_radia) 124 !====================================================================== 125 125 LOGICAL check ! Verifier la conservation du modele en eau 126 126 PARAMETER (check=.FALSE.) 127 127 LOGICAL ok_stratus ! Ajouter artificiellement les stratus 128 128 PARAMETER (ok_stratus=.FALSE.) 129 c======================================================================129 !====================================================================== 130 130 REAL amn, amx 131 131 INTEGER igout 132 c======================================================================133 cClef controlant l'activation du cycle diurne:134 ccc LOGICAL cycle_diurne135 ccc PARAMETER (cycle_diurne=.FALSE.)136 c======================================================================137 cModele thermique du sol, a activer pour le cycle diurne:138 ccc LOGICAL soil_model139 ccc PARAMETER (soil_model=.FALSE.)140 c======================================================================141 cDans les versions precedentes, l'eau liquide nuageuse utilisee dans142 cle calcul du rayonnement est celle apres la precipitation des nuages.143 cSi cette cle new_oliq est activee, ce sera une valeur moyenne entre144 cla condensation et la precipitation. Cette cle augmente les impacts145 cradiatifs des nuages.146 ccc LOGICAL new_oliq147 ccc PARAMETER (new_oliq=.FALSE.)148 c======================================================================149 cClefs controlant deux parametrisations de l'orographie:150 cc LOGICAL ok_orodr151 ccc PARAMETER (ok_orodr=.FALSE.)152 ccc LOGICAL ok_orolf153 ccc PARAMETER (ok_orolf=.FALSE.)154 c======================================================================132 !====================================================================== 133 ! Clef controlant l'activation du cycle diurne: 134 !cc LOGICAL cycle_diurne 135 !cc PARAMETER (cycle_diurne=.FALSE.) 136 !====================================================================== 137 ! Modele thermique du sol, a activer pour le cycle diurne: 138 !cc LOGICAL soil_model 139 !cc PARAMETER (soil_model=.FALSE.) 140 !====================================================================== 141 ! Dans les versions precedentes, l'eau liquide nuageuse utilisee dans 142 ! le calcul du rayonnement est celle apres la precipitation des nuages. 143 ! Si cette cle new_oliq est activee, ce sera une valeur moyenne entre 144 ! la condensation et la precipitation. Cette cle augmente les impacts 145 ! radiatifs des nuages. 146 !cc LOGICAL new_oliq 147 !cc PARAMETER (new_oliq=.FALSE.) 148 !====================================================================== 149 ! Clefs controlant deux parametrisations de l'orographie: 150 !c LOGICAL ok_orodr 151 !cc PARAMETER (ok_orodr=.FALSE.) 152 !cc LOGICAL ok_orolf 153 !cc PARAMETER (ok_orolf=.FALSE.) 154 !====================================================================== 155 155 LOGICAL ok_journe ! sortir le fichier journalier 156 156 save ok_journe 157 c$OMP THREADPRIVATE(ok_journe)158 c 157 !$OMP THREADPRIVATE(ok_journe) 158 ! 159 159 LOGICAL ok_mensuel ! sortir le fichier mensuel 160 160 save ok_mensuel 161 c$OMP THREADPRIVATE(ok_mensuel)162 c 161 !$OMP THREADPRIVATE(ok_mensuel) 162 ! 163 163 LOGICAL ok_instan ! sortir le fichier instantane 164 164 save ok_instan 165 c$OMP THREADPRIVATE(ok_instan)166 c 165 !$OMP THREADPRIVATE(ok_instan) 166 ! 167 167 LOGICAL ok_LES ! sortir le fichier LES 168 168 save ok_LES 169 c$OMP THREADPRIVATE(ok_LES)170 c 169 !$OMP THREADPRIVATE(ok_LES) 170 ! 171 171 LOGICAL callstats ! sortir le fichier stats 172 172 save callstats 173 c$OMP THREADPRIVATE(callstats)174 c 173 !$OMP THREADPRIVATE(callstats) 174 ! 175 175 LOGICAL ok_region ! sortir le fichier regional 176 176 PARAMETER (ok_region=.FALSE.) 177 c======================================================================177 !====================================================================== 178 178 real seuil_inversion 179 179 save seuil_inversion 180 c$OMP THREADPRIVATE(seuil_inversion)180 !$OMP THREADPRIVATE(seuil_inversion) 181 181 integer iflag_ratqs 182 182 save iflag_ratqs 183 c$OMP THREADPRIVATE(iflag_ratqs)183 !$OMP THREADPRIVATE(iflag_ratqs) 184 184 real facteur 185 185 … … 194 194 real zqsatth(klon,klev) 195 195 196 c======================================================================197 c 196 !====================================================================== 197 ! 198 198 INTEGER ivap ! indice de traceurs pour vapeur d'eau 199 199 PARAMETER (ivap=1) … … 201 201 PARAMETER (iliq=2) 202 202 203 c 204 c 205 cVariables argument:206 c 203 ! 204 ! 205 ! Variables argument: 206 ! 207 207 INTEGER nlon 208 208 INTEGER nlev … … 222 222 REAL v(klon,klev) 223 223 REAL t(klon,klev),thetal(klon,klev) 224 cthetal: ligne suivante a decommenter si vous avez les fichiers MPL 20130625225 cfth_fonctions.F90 et parkind1.F90226 csinon thetal=theta227 cREAL fth_thetae,fth_thetav,fth_thetal224 ! thetal: ligne suivante a decommenter si vous avez les fichiers MPL 20130625 225 ! fth_fonctions.F90 et parkind1.F90 226 ! sinon thetal=theta 227 ! REAL fth_thetae,fth_thetav,fth_thetal 228 228 REAL qx(klon,klev,nqtot) 229 229 REAL flxmass_w(klon,klev) … … 245 245 !IM definition dynamique o_trac dans phys_output_open 246 246 ! type(ctrl_out) :: o_trac(nqtot) 247 c 248 cIM Amip2 PV a theta constante249 c 247 ! 248 !IM Amip2 PV a theta constante 249 ! 250 250 INTEGER nbteta 251 251 PARAMETER(nbteta=3) … … 253 253 DATA ctetaSTD/'350','380','405'/ 254 254 SAVE ctetaSTD 255 c$OMP THREADPRIVATE(ctetaSTD)255 !$OMP THREADPRIVATE(ctetaSTD) 256 256 REAL rtetaSTD(nbteta) 257 257 DATA rtetaSTD/350., 380., 405./ 258 258 SAVE rtetaSTD 259 c$OMP THREADPRIVATE(rtetaSTD)260 c 259 !$OMP THREADPRIVATE(rtetaSTD) 260 ! 261 261 REAL PVteta(klon,nbteta) 262 262 REAL zx_tmp_3dte(iim,jjmp1,nbteta) 263 c 264 cMI Amip2 PV a theta constante265 266 cym INTEGER klevp1, klevm1267 cym PARAMETER(klevp1=klev+1,klevm1=klev-1)268 cym#include "raddim.h"269 c 270 c 271 cIM Amip2272 cvariables a une pression donnee273 c 263 ! 264 !MI Amip2 PV a theta constante 265 266 !ym INTEGER klevp1, klevm1 267 !ym PARAMETER(klevp1=klev+1,klevm1=klev-1) 268 !ym#include "raddim.h" 269 ! 270 ! 271 !IM Amip2 272 ! variables a une pression donnee 273 ! 274 274 #include "declare_STDlev.h" 275 c 275 ! 276 276 CHARACTER*4 bb2 277 277 CHARACTER*2 bb3 278 c 278 ! 279 279 #include "radopt.h" 280 c 281 c 280 ! 281 ! 282 282 283 283 REAL convliq(klon,klev) ! eau liquide nuageuse convective … … 290 290 291 291 INTEGER linv, kp1 292 cflwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)293 cflwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)292 ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2) 293 ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg) 294 294 REAL flwp_c(klon), fiwp_c(klon) 295 295 REAL flwc_c(klon,klev), fiwc_c(klon,klev) … … 298 298 299 299 300 cIM ISCCP simulator v3.4301 cdans clesphys.h top_height, overlap302 cv3.4300 !IM ISCCP simulator v3.4 301 ! dans clesphys.h top_height, overlap 302 !v3.4 303 303 INTEGER debug, debugcol 304 cym INTEGER npoints305 cym PARAMETER(npoints=klon)306 c 304 !ym INTEGER npoints 305 !ym PARAMETER(npoints=klon) 306 ! 307 307 INTEGER sunlit(klon) !sunlit=1 if day; sunlit=0 if night 308 308 INTEGER nregISCtot 309 309 PARAMETER(nregISCtot=1) 310 c 311 cimin_debut, nbpti, jmin_debut, nbptj : parametres pour sorties sur 1 region rectangulaire312 cy compris pour 1 point313 cimin_debut : indice minimum de i; nbpti : nombre de points en direction i (longitude)314 cjmin_debut : indice minimum de j; nbptj : nombre de points en direction j (latitude)310 ! 311 ! imin_debut, nbpti, jmin_debut, nbptj : parametres pour sorties sur 1 region rectangulaire 312 ! y compris pour 1 point 313 ! imin_debut : indice minimum de i; nbpti : nombre de points en direction i (longitude) 314 ! jmin_debut : indice minimum de j; nbptj : nombre de points en direction j (latitude) 315 315 INTEGER imin_debut, nbpti 316 316 INTEGER jmin_debut, nbptj 317 cIM parametres ISCCP BEG317 !IM parametres ISCCP BEG 318 318 INTEGER nbapp_isccp 319 319 ! INTEGER nbapp_isccp,isccppas … … 324 324 DATA ifreq_isccp/3/ 325 325 SAVE ifreq_isccp 326 c$OMP THREADPRIVATE(ifreq_isccp)326 !$OMP THREADPRIVATE(ifreq_isccp) 327 327 CHARACTER*5 typinout(napisccp) 328 328 DATA typinout/'i3od'/ 329 329 SAVE typinout 330 c$OMP THREADPRIVATE(typinout)331 cIM verif boxptop BEG330 !$OMP THREADPRIVATE(typinout) 331 !IM verif boxptop BEG 332 332 CHARACTER*1 verticaxe(napisccp) 333 333 DATA verticaxe/'1'/ 334 334 SAVE verticaxe 335 c$OMP THREADPRIVATE(verticaxe)336 cIM verif boxptop END335 !$OMP THREADPRIVATE(verticaxe) 336 !IM verif boxptop END 337 337 INTEGER nvlev(napisccp) 338 cINTEGER nvlev338 ! INTEGER nvlev 339 339 REAL t1, aa 340 340 REAL seed_re(klon,napisccp) 341 cym !!!! A voir plus tard342 cym INTEGER iphy(iim,jjmp1)343 cIM parametres ISCCP END344 c 345 cncol = nb. de sous-colonnes pour chaque maille du GCM346 cncolmx = No. max. de sous-colonnes pour chaque maille du GCM347 cINTEGER ncol(napisccp), ncolmx, seed(klon,napisccp)341 !ym !!!! A voir plus tard 342 !ym INTEGER iphy(iim,jjmp1) 343 !IM parametres ISCCP END 344 ! 345 ! ncol = nb. de sous-colonnes pour chaque maille du GCM 346 ! ncolmx = No. max. de sous-colonnes pour chaque maille du GCM 347 ! INTEGER ncol(napisccp), ncolmx, seed(klon,napisccp) 348 348 INTEGER,SAVE :: ncol(napisccp) 349 c$OMP THREADPRIVATE(ncol)349 !$OMP THREADPRIVATE(ncol) 350 350 INTEGER ncolmx, seed(klon,napisccp) 351 351 REAL nbsunlit(nregISCtot,klon,napisccp) !nbsunlit : moyenne de sunlit 352 cPARAMETER(ncolmx=1500)352 ! PARAMETER(ncolmx=1500) 353 353 PARAMETER(ncolmx=300) 354 c 355 cIM verif boxptop BEG354 ! 355 !IM verif boxptop BEG 356 356 REAL vertlev(ncolmx,napisccp) 357 cIM verif boxptop END358 c 357 !IM verif boxptop END 358 ! 359 359 REAL,SAVE :: tautab_omp(0:255),tautab(0:255) 360 360 INTEGER,SAVE :: invtau_omp(-20:45000),invtau(-20:45000) 361 c$OMP THREADPRIVATE(tautab,invtau)361 !$OMP THREADPRIVATE(tautab,invtau) 362 362 REAL emsfc_lw 363 363 PARAMETER(emsfc_lw=0.99) 364 cREAL ran0 ! type for random number fuction365 c 364 ! REAL ran0 ! type for random number fuction 365 ! 366 366 REAL cldtot(klon,klev) 367 cvariables de haut en bas pour le simulateur ISCCP367 ! variables de haut en bas pour le simulateur ISCCP 368 368 REAL dtau_s(klon,klev) !tau nuages startiformes 369 369 REAL dtau_c(klon,klev) !tau nuages convectifs 370 370 REAL dem_s(klon,klev) !emissivite nuages startiformes 371 371 REAL dem_c(klon,klev) !emissivite nuages convectifs 372 c 373 cvariables de haut en bas pour le simulateur ISCCP372 ! 373 ! variables de haut en bas pour le simulateur ISCCP 374 374 REAL pfull(klon,klev) 375 375 REAL phalf(klon,klev+1) … … 382 382 REAL dem_sH2B(klon,klev) 383 383 REAL dem_cH2B(klon,klev) 384 c 384 ! 385 385 INTEGER kmax, lmax, lmax3 386 386 PARAMETER(kmax=8, lmax=8, lmax3=3) … … 388 388 PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1) 389 389 INTEGER iimx7, jjmx7, jjmp1x7 390 PARAMETER(iimx7=iim*kmaxm1, jjmx7=jjm*lmaxm1, 391 .jjmp1x7=jjmp1*lmaxm1)392 c 393 coutput from ISCCP simulator390 PARAMETER(iimx7=iim*kmaxm1, jjmx7=jjm*lmaxm1, & 391 jjmp1x7=jjmp1*lmaxm1) 392 ! 393 ! output from ISCCP simulator 394 394 REAL fq_isccp(klon,kmaxm1,lmaxm1,napisccp) 395 395 REAL fq_is_true(klon,kmaxm1,lmaxm1,napisccp) … … 401 401 REAL zx_tmp_fi3d_bx(klon,ncolmx) 402 402 REAL zx_tmp_3d_bx(iim,jjmp1,ncolmx) 403 c 403 ! 404 404 REAL cld_fi3d(klon,lmax3) 405 405 REAL cld_3d(iim,jjmp1,lmax3) 406 c 406 ! 407 407 INTEGER iw, iwmax 408 408 REAL wmin, pas_w 409 cPARAMETER(wmin=-100.,pas_w=10.,iwmax=30)410 cIM 051005 PARAMETER(wmin=-200.,pas_w=10.,iwmax=40)409 ! PARAMETER(wmin=-100.,pas_w=10.,iwmax=30) 410 !IM 051005 PARAMETER(wmin=-200.,pas_w=10.,iwmax=40) 411 411 PARAMETER(wmin=-100.,pas_w=10.,iwmax=20) 412 412 REAL o500(klon) 413 c 414 415 csorties ISCCP413 ! 414 415 ! sorties ISCCP 416 416 417 417 integer nid_isccp 418 418 save nid_isccp 419 c$OMP THREADPRIVATE(nid_isccp)419 !$OMP THREADPRIVATE(nid_isccp) 420 420 421 421 REAL zx_tau(kmaxm1), zx_pc(lmaxm1), zx_o500(iwmax) … … 424 424 DATA zx_pc/180., 310., 440., 560., 680., 800., 1000./ 425 425 SAVE zx_pc 426 c$OMP THREADPRIVATE(zx_tau,zx_pc)427 ccldtopres pression au sommet des nuages426 !$OMP THREADPRIVATE(zx_tau,zx_pc) 427 ! cldtopres pression au sommet des nuages 428 428 REAL cldtopres(lmaxm1), cldtopres3(lmax3) 429 429 DATA cldtopres/180., 310., 440., 560., 680., 800., 1000./ 430 430 DATA cldtopres3/440., 680., 1000./ 431 431 SAVE cldtopres,cldtopres3 432 c$OMP THREADPRIVATE(cldtopres,cldtopres3)433 cIM 051005 BEG432 !$OMP THREADPRIVATE(cldtopres,cldtopres3) 433 !IM 051005 BEG 434 434 INTEGER komega, nhoriRD 435 435 436 ctaulev: numero du niveau de tau dans les sorties ISCCP436 ! taulev: numero du niveau de tau dans les sorties ISCCP 437 437 CHARACTER *4 taulev(kmaxm1) 438 cDATA taulev/'tau1','tau2','tau3','tau4','tau5','tau6','tau7'/438 ! DATA taulev/'tau1','tau2','tau3','tau4','tau5','tau6','tau7'/ 439 439 DATA taulev/'tau0','tau1','tau2','tau3','tau4','tau5','tau6'/ 440 440 CHARACTER *3 pclev(lmaxm1) 441 441 DATA pclev/'pc1','pc2','pc3','pc4','pc5','pc6','pc7'/ 442 442 SAVE taulev,pclev 443 c$OMP THREADPRIVATE(taulev,pclev)444 c 445 ccnameisccp443 !$OMP THREADPRIVATE(taulev,pclev) 444 ! 445 ! cnameisccp 446 446 CHARACTER *29 cnameisccp(lmaxm1,kmaxm1) 447 cIM bad 151205 DATA cnameisccp/'pc< 50hPa, tau< 0.3',448 DATA cnameisccp/'pc= 50-180hPa, tau< 0.3', 449 . 'pc= 180-310hPa, tau< 0.3',450 . 'pc= 310-440hPa, tau< 0.3',451 . 'pc= 440-560hPa, tau< 0.3',452 . 'pc= 560-680hPa, tau< 0.3',453 . 'pc= 680-800hPa, tau< 0.3',454 . 'pc= 800-1000hPa, tau< 0.3',455 . 'pc= 50-180hPa, tau= 0.3-1.3',456 . 'pc= 180-310hPa, tau= 0.3-1.3',457 . 'pc= 310-440hPa, tau= 0.3-1.3',458 . 'pc= 440-560hPa, tau= 0.3-1.3',459 . 'pc= 560-680hPa, tau= 0.3-1.3',460 . 'pc= 680-800hPa, tau= 0.3-1.3',461 . 'pc= 800-1000hPa, tau= 0.3-1.3',462 . 'pc= 50-180hPa, tau= 1.3-3.6',463 . 'pc= 180-310hPa, tau= 1.3-3.6',464 . 'pc= 310-440hPa, tau= 1.3-3.6',465 . 'pc= 440-560hPa, tau= 1.3-3.6',466 . 'pc= 560-680hPa, tau= 1.3-3.6',467 . 'pc= 680-800hPa, tau= 1.3-3.6',468 . 'pc= 800-1000hPa, tau= 1.3-3.6',469 . 'pc= 50-180hPa, tau= 3.6-9.4',470 . 'pc= 180-310hPa, tau= 3.6-9.4',471 . 'pc= 310-440hPa, tau= 3.6-9.4',472 . 'pc= 440-560hPa, tau= 3.6-9.4',473 . 'pc= 560-680hPa, tau= 3.6-9.4',474 . 'pc= 680-800hPa, tau= 3.6-9.4',475 . 'pc= 800-1000hPa, tau= 3.6-9.4',476 . 'pc= 50-180hPa, tau= 9.4-23',477 . 'pc= 180-310hPa, tau= 9.4-23',478 . 'pc= 310-440hPa, tau= 9.4-23',479 . 'pc= 440-560hPa, tau= 9.4-23',480 . 'pc= 560-680hPa, tau= 9.4-23',481 . 'pc= 680-800hPa, tau= 9.4-23',482 . 'pc= 800-1000hPa, tau= 9.4-23',483 . 'pc= 50-180hPa, tau= 23-60',484 . 'pc= 180-310hPa, tau= 23-60',485 . 'pc= 310-440hPa, tau= 23-60',486 . 'pc= 440-560hPa, tau= 23-60',487 . 'pc= 560-680hPa, tau= 23-60',488 . 'pc= 680-800hPa, tau= 23-60',489 . 'pc= 800-1000hPa, tau= 23-60',490 . 'pc= 50-180hPa, tau> 60.',491 . 'pc= 180-310hPa, tau> 60.',492 . 'pc= 310-440hPa, tau> 60.',493 . 'pc= 440-560hPa, tau> 60.',494 . 'pc= 560-680hPa, tau> 60.',495 . 'pc= 680-800hPa, tau> 60.',496 .'pc= 800-1000hPa, tau> 60.'/447 !IM bad 151205 DATA cnameisccp/'pc< 50hPa, tau< 0.3', 448 DATA cnameisccp/'pc= 50-180hPa, tau< 0.3', & 449 'pc= 180-310hPa, tau< 0.3', & 450 'pc= 310-440hPa, tau< 0.3', & 451 'pc= 440-560hPa, tau< 0.3', & 452 'pc= 560-680hPa, tau< 0.3', & 453 'pc= 680-800hPa, tau< 0.3', & 454 'pc= 800-1000hPa, tau< 0.3', & 455 'pc= 50-180hPa, tau= 0.3-1.3', & 456 'pc= 180-310hPa, tau= 0.3-1.3', & 457 'pc= 310-440hPa, tau= 0.3-1.3', & 458 'pc= 440-560hPa, tau= 0.3-1.3', & 459 'pc= 560-680hPa, tau= 0.3-1.3', & 460 'pc= 680-800hPa, tau= 0.3-1.3', & 461 'pc= 800-1000hPa, tau= 0.3-1.3', & 462 'pc= 50-180hPa, tau= 1.3-3.6', & 463 'pc= 180-310hPa, tau= 1.3-3.6', & 464 'pc= 310-440hPa, tau= 1.3-3.6', & 465 'pc= 440-560hPa, tau= 1.3-3.6', & 466 'pc= 560-680hPa, tau= 1.3-3.6', & 467 'pc= 680-800hPa, tau= 1.3-3.6', & 468 'pc= 800-1000hPa, tau= 1.3-3.6', & 469 'pc= 50-180hPa, tau= 3.6-9.4', & 470 'pc= 180-310hPa, tau= 3.6-9.4', & 471 'pc= 310-440hPa, tau= 3.6-9.4', & 472 'pc= 440-560hPa, tau= 3.6-9.4', & 473 'pc= 560-680hPa, tau= 3.6-9.4', & 474 'pc= 680-800hPa, tau= 3.6-9.4', & 475 'pc= 800-1000hPa, tau= 3.6-9.4', & 476 'pc= 50-180hPa, tau= 9.4-23', & 477 'pc= 180-310hPa, tau= 9.4-23', & 478 'pc= 310-440hPa, tau= 9.4-23', & 479 'pc= 440-560hPa, tau= 9.4-23', & 480 'pc= 560-680hPa, tau= 9.4-23', & 481 'pc= 680-800hPa, tau= 9.4-23', & 482 'pc= 800-1000hPa, tau= 9.4-23', & 483 'pc= 50-180hPa, tau= 23-60', & 484 'pc= 180-310hPa, tau= 23-60', & 485 'pc= 310-440hPa, tau= 23-60', & 486 'pc= 440-560hPa, tau= 23-60', & 487 'pc= 560-680hPa, tau= 23-60', & 488 'pc= 680-800hPa, tau= 23-60', & 489 'pc= 800-1000hPa, tau= 23-60', & 490 'pc= 50-180hPa, tau> 60.', & 491 'pc= 180-310hPa, tau> 60.', & 492 'pc= 310-440hPa, tau> 60.', & 493 'pc= 440-560hPa, tau> 60.', & 494 'pc= 560-680hPa, tau> 60.', & 495 'pc= 680-800hPa, tau> 60.', & 496 'pc= 800-1000hPa, tau> 60.'/ 497 497 SAVE cnameisccp 498 c$OMP THREADPRIVATE(cnameisccp)499 c 500 cREAL zx_lonx7(iimx7), zx_latx7(jjmp1x7)501 cINTEGER nhorix7502 cIM: region='3d' <==> sorties en global498 !$OMP THREADPRIVATE(cnameisccp) 499 ! 500 ! REAL zx_lonx7(iimx7), zx_latx7(jjmp1x7) 501 ! INTEGER nhorix7 502 !IM: region='3d' <==> sorties en global 503 503 CHARACTER*3 region 504 504 PARAMETER(region='3d') 505 c 506 cIM ISCCP simulator v3.4507 c 505 ! 506 !IM ISCCP simulator v3.4 507 ! 508 508 logical ok_hf 509 c 509 ! 510 510 integer nid_hf, nid_hf3d 511 511 save ok_hf, nid_hf, nid_hf3d 512 c$OMP THREADPRIVATE(ok_hf, nid_hf, nid_hf3d)513 cQUESTION : noms de variables ?512 !$OMP THREADPRIVATE(ok_hf, nid_hf, nid_hf3d) 513 ! QUESTION : noms de variables ? 514 514 515 515 INTEGER longcles 516 516 PARAMETER ( longcles = 20 ) 517 517 REAL clesphy0( longcles ) 518 c 519 cVariables propres a la physique518 ! 519 ! Variables propres a la physique 520 520 INTEGER itap 521 521 SAVE itap ! compteur pour la physique 522 c$OMP THREADPRIVATE(itap)523 c 522 !$OMP THREADPRIVATE(itap) 523 ! 524 524 REAL,save :: solarlong0 525 c$OMP THREADPRIVATE(solarlong0)526 527 c 528 cParametres de l'Orographie a l'Echelle Sous-Maille (OESM):529 c 530 cIM 141004 REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)525 !$OMP THREADPRIVATE(solarlong0) 526 527 ! 528 ! Parametres de l'Orographie a l'Echelle Sous-Maille (OESM): 529 ! 530 !IM 141004 REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon) 531 531 REAL zulow(klon),zvlow(klon) 532 c 532 ! 533 533 INTEGER igwd,idx(klon),itest(klon) 534 c 535 cREAL,allocatable,save :: run_off_lic_0(:)536 cc$OMP THREADPRIVATE(run_off_lic_0)537 cym SAVE run_off_lic_0538 cKE43539 cVariables liees a la convection de K. Emanuel (sb):540 c 534 ! 535 ! REAL,allocatable,save :: run_off_lic_0(:) 536 !!$OMP THREADPRIVATE(run_off_lic_0) 537 !ym SAVE run_off_lic_0 538 !KE43 539 ! Variables liees a la convection de K. Emanuel (sb): 540 ! 541 541 REAL bas, top ! cloud base and top levels 542 542 SAVE bas 543 543 SAVE top 544 c$OMP THREADPRIVATE(bas, top)544 !$OMP THREADPRIVATE(bas, top) 545 545 546 546 REAL wdn(klon), tdn(klon), qdn(klon) 547 c 548 c=================================================================================================549 cCR04.12.07: on ajoute les nouvelles variables du nouveau schema de convection avec poches froides550 cVariables li\'ees \`a la poche froide (jyg)547 ! 548 !================================================================================================= 549 !CR04.12.07: on ajoute les nouvelles variables du nouveau schema de convection avec poches froides 550 ! Variables li\'ees \`a la poche froide (jyg) 551 551 552 552 REAL mip(klon,klev) ! mass flux shed by the adiab ascent at each level 553 c 553 ! 554 554 REAL wape_prescr, fip_prescr 555 555 INTEGER it_wape_prescr 556 556 SAVE wape_prescr, fip_prescr, it_wape_prescr 557 c$OMP THREADPRIVATE(wape_prescr, fip_prescr, it_wape_prescr)558 c 559 cvariables supplementaires de concvl557 !$OMP THREADPRIVATE(wape_prescr, fip_prescr, it_wape_prescr) 558 ! 559 ! variables supplementaires de concvl 560 560 REAL Tconv(klon,klev) 561 561 REAL ment(klon,klev,klev),sij(klon,klev,klev) … … 570 570 real, save :: wake_s_min_lsp=0.1 571 571 572 c$OMP THREADPRIVATE(alp_bl_prescr,ale_bl_prescr)573 c$OMP THREADPRIVATE(ale_max,alp_max)574 c$OMP THREADPRIVATE(wake_s_min_lsp)572 !$OMP THREADPRIVATE(alp_bl_prescr,ale_bl_prescr) 573 !$OMP THREADPRIVATE(ale_max,alp_max) 574 !$OMP THREADPRIVATE(wake_s_min_lsp) 575 575 576 576 577 577 real ok_wk_lsp(klon) 578 578 579 cRC580 cVariables li\'ees \`a la poche froide (jyg et rr)581 cVersion diagnostique pour l'instant : pas de r\'etroaction sur la convection579 !RC 580 ! Variables li\'ees \`a la poche froide (jyg et rr) 581 ! Version diagnostique pour l'instant : pas de r\'etroaction sur la convection 582 582 583 583 REAL t_wake(klon,klev),q_wake(klon,klev) ! wake pour la convection … … 595 595 REAL wake_dp_deltomg(klon,klev) ! Wake : gradient vertical de wake_omg 596 596 REAL wake_spread(klon,klev) ! spreading term in wake_delt 597 c 598 cpourquoi y'a pas de save??599 c 597 ! 598 !pourquoi y'a pas de save?? 599 ! 600 600 INTEGER wake_k(klon) ! Wake sommet 601 c 601 ! 602 602 REAL t_undi(klon,klev) ! temperature moyenne dans la zone non perturbee 603 603 REAL q_undi(klon,klev) ! humidite moyenne dans la zone non perturbee 604 c 605 cjyg606 ccc REAL wake_pe(klon) ! Wake potential energy - WAPE604 ! 605 !jyg 606 !cc REAL wake_pe(klon) ! Wake potential energy - WAPE 607 607 608 608 REAL wake_gfl(klon) ! Gust Front Length 609 609 REAL wake_dens(klon) 610 c 611 c 610 ! 611 ! 612 612 REAL dt_dwn(klon,klev) 613 613 REAL dq_dwn(klon,klev) … … 621 621 REAL dq_a(klon,klev) 622 622 REAL, SAVE :: alp_offset 623 c$OMP THREADPRIVATE(alp_offset)624 625 c 626 cRR:fin declarations poches froides627 c=======================================================================================================623 !$OMP THREADPRIVATE(alp_offset) 624 625 ! 626 !RR:fin declarations poches froides 627 !======================================================================================================= 628 628 629 629 REAL ztv(klon,klev),ztva(klon,klev) … … 632 632 REAL zthl(klon,klev) 633 633 634 ccc nrlmd le 10/04/2012635 636 c--------Stochastic Boundary Layer Triggering: ALE_BL--------637 c---Propri\'et\'es du thermiques au LCL634 !cc nrlmd le 10/04/2012 635 636 !--------Stochastic Boundary Layer Triggering: ALE_BL-------- 637 !---Propri\'et\'es du thermiques au LCL 638 638 real zlcl_th(klon) ! Altitude du LCL calcul\'e continument (pcon dans thermcell_main.F90) 639 639 real fraca0(klon) ! Fraction des thermiques au LCL … … 644 644 real env_tke_max0(klon) ! TKE dans l'environnement au LCL 645 645 646 c---D\'eclenchement stochastique646 !---D\'eclenchement stochastique 647 647 integer :: tau_trig(klon) 648 648 649 c--------Statistical Boundary Layer Closure: ALP_BL--------650 c---Profils de TKE dans et hors du thermique649 !--------Statistical Boundary Layer Closure: ALP_BL-------- 650 !---Profils de TKE dans et hors du thermique 651 651 real pbl_tke_input(klon,klev+1,nbsrf) 652 652 real therm_tke_max(klon,klev) ! Profil de TKE dans les thermiques … … 654 654 655 655 656 ccc fin nrlmd le 10/04/2012657 658 cVariables locales pour la couche limite (al1):659 c 660 cAl1 REAL pblh(klon) ! Hauteur de couche limite661 cAl1 SAVE pblh662 c34EK663 c 664 cVariables locales:665 c 666 cAA667 cAA Pour phytrac656 !cc fin nrlmd le 10/04/2012 657 658 ! Variables locales pour la couche limite (al1): 659 ! 660 !Al1 REAL pblh(klon) ! Hauteur de couche limite 661 !Al1 SAVE pblh 662 !34EK 663 ! 664 ! Variables locales: 665 ! 666 !AA 667 !AA Pour phytrac 668 668 REAL u1(klon) ! vents dans la premiere couche U 669 669 REAL v1(klon) ! vents dans la premiere couche V 670 670 671 c@$$ LOGICAL offline ! Controle du stockage ds "physique"672 c@$$ PARAMETER (offline=.false.)673 c@$$ INTEGER physid671 !@$$ LOGICAL offline ! Controle du stockage ds "physique" 672 !@$$ PARAMETER (offline=.false.) 673 !@$$ INTEGER physid 674 674 REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction) 675 675 REAL frac_nucl(klon,klev) ! idem (nucleation) … … 680 680 REAL :: calday 681 681 682 cIM cf FH pour Tiedtke 080604682 !IM cf FH pour Tiedtke 080604 683 683 REAL rain_tiedtke(klon),snow_tiedtke(klon) 684 c 685 cIM 050204 END684 ! 685 !IM 050204 END 686 686 REAL devap(klon) ! evaporation et sa derivee 687 687 REAL dsens(klon) ! chaleur sensible et sa derivee 688 688 689 c 690 cConditions aux limites691 c 689 ! 690 ! Conditions aux limites 691 ! 692 692 ! 693 693 REAL :: day_since_equinox … … 698 698 LOGICAL, parameter :: new_orbit = .true. 699 699 700 c 700 ! 701 701 INTEGER lmt_pas 702 702 SAVE lmt_pas ! frequence de mise a jour 703 c$OMP THREADPRIVATE(lmt_pas)703 !$OMP THREADPRIVATE(lmt_pas) 704 704 real zmasse(klon, llm),exner(klon, llm) 705 C(column-density of mass of air in a cell, in kg m-2)705 ! (column-density of mass of air in a cell, in kg m-2) 706 706 real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 707 707 708 cIM sorties708 !IM sorties 709 709 REAL un_jour 710 710 PARAMETER(un_jour=86400.) 711 c======================================================================712 c 713 cDeclaration des procedures appelees714 c 711 !====================================================================== 712 ! 713 ! Declaration des procedures appelees 714 ! 715 715 EXTERNAL angle ! calculer angle zenithal du soleil 716 716 EXTERNAL alboc ! calculer l'albedo sur ocean 717 717 EXTERNAL ajsec ! ajustement sec 718 718 EXTERNAL conlmd ! convection (schema LMD) 719 cKE43719 !KE43 720 720 EXTERNAL conema3 ! convect4.3 721 721 EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie) 722 cAA722 !AA 723 723 EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie) 724 c! stockage des coefficients necessaires au725 c! lessivage OFF-LINE et ON-LINE724 ! ! stockage des coefficients necessaires au 725 ! ! lessivage OFF-LINE et ON-LINE 726 726 EXTERNAL hgardfou ! verifier les temperatures 727 727 EXTERNAL nuage ! calculer les proprietes radiatives 728 CC EXTERNAL o3cm ! initialiser l'ozone728 !C EXTERNAL o3cm ! initialiser l'ozone 729 729 EXTERNAL orbite ! calculer l'orbite terrestre 730 730 EXTERNAL phyetat0 ! lire l'etat initial de la physique … … 736 736 EXTERNAL ecrirega ! ecrire le fichier binaire regional 737 737 EXTERNAL ecriregs ! ecrire le fichier binaire regional 738 cIM738 !IM 739 739 EXTERNAL haut2bas !variables de haut en bas 740 740 EXTERNAL ini_undefSTD !initialise a 0 une variable a 1 niveau de pression 741 741 EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression 742 cEXTERNAL moy_undefSTD !moyenne d'1 var a 1 niveau de pression743 cEXTERNAL moyglo_aire !moyenne globale d'1 var ponderee par l'aire de la maille (moyglo_pondaire)744 c!par la masse/airetot (moyglo_pondaima) et la vraie masse (moyglo_pondmass)745 c 746 cVariables locales747 c 742 ! EXTERNAL moy_undefSTD !moyenne d'1 var a 1 niveau de pression 743 ! EXTERNAL moyglo_aire !moyenne globale d'1 var ponderee par l'aire de la maille (moyglo_pondaire) 744 ! !par la masse/airetot (moyglo_pondaima) et la vraie masse (moyglo_pondmass) 745 ! 746 ! Variables locales 747 ! 748 748 REAL rhcl(klon,klev) ! humiditi relative ciel clair 749 749 REAL dialiq(klon,klev) ! eau liquide nuageuse 750 750 REAL diafra(klon,klev) ! fraction nuageuse 751 751 REAL cldliq(klon,klev) ! eau liquide nuageuse 752 c 753 CXXX PB752 ! 753 !XXX PB 754 754 REAL fluxq(klon,klev, nbsrf) ! flux turbulent d'humidite 755 c 755 ! 756 756 REAL zxfluxt(klon, klev) 757 757 REAL zxfluxq(klon, klev) … … 759 759 REAL zxfluxv(klon, klev) 760 760 761 cLe rayonnement n'est pas calcule tous les pas, il faut donc762 csauvegarder les sorties du rayonnement763 cym SAVE heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown764 cym SAVE sollwdownclr, toplwdown, toplwdownclr765 cym SAVE topsw0,toplw0,solsw0,sollw0, heat0, cool0766 c 761 ! Le rayonnement n'est pas calcule tous les pas, il faut donc 762 ! sauvegarder les sorties du rayonnement 763 !ym SAVE heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown 764 !ym SAVE sollwdownclr, toplwdown, toplwdownclr 765 !ym SAVE topsw0,toplw0,solsw0,sollw0, heat0, cool0 766 ! 767 767 INTEGER itaprad 768 768 SAVE itaprad 769 c$OMP THREADPRIVATE(itaprad)770 c 769 !$OMP THREADPRIVATE(itaprad) 770 ! 771 771 REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s) 772 772 REAL conv_t(klon,klev) ! convergence de la temperature(K/s) 773 773 774 c 774 ! 775 775 REAL zxsnow(klon) 776 776 REAL zxsnow_dummy(klon) 777 c 777 ! 778 778 REAL dist, rmu0(klon), fract(klon) 779 779 REAL zdtime, zlongi 780 c 780 ! 781 781 CHARACTER*2 str2 782 782 CHARACTER*2 iqn 783 c 783 ! 784 784 REAL qcheck 785 785 REAL z_avant(klon), z_apres(klon), z_factor(klon) 786 786 LOGICAL zx_ajustq 787 c 787 ! 788 788 REAL za, zb 789 789 REAL zx_t, zx_qs, zdelta, zcor, zfra, zlvdcp, zlsdcp … … 793 793 PARAMETER (t_coup=234.0) 794 794 795 cym A voir plus tard !!796 cym REAL zx_relief(iim,jjmp1)797 cym REAL zx_aire(iim,jjmp1)798 c 799 cGrandeurs de sorties795 !ym A voir plus tard !! 796 !ym REAL zx_relief(iim,jjmp1) 797 !ym REAL zx_aire(iim,jjmp1) 798 ! 799 ! Grandeurs de sorties 800 800 REAL s_capCL(klon) 801 801 REAL s_oliqCL(klon), s_cteiCL(klon) 802 802 REAL s_trmb1(klon), s_trmb2(klon) 803 803 REAL s_trmb3(klon) 804 cKE43805 cVariables locales pour la convection de K. Emanuel (sb):804 !KE43 805 ! Variables locales pour la convection de K. Emanuel (sb): 806 806 807 807 REAL tvp(klon,klev) ! virtual temp of lifted parcel … … 811 811 INTEGER iflagctrl(klon) ! flag fonctionnement de convect 812 812 813 c-- convect43:813 ! -- convect43: 814 814 INTEGER ntra ! nb traceurs pour convect4.3 815 815 REAL pori_con(klon) ! pressure at the origin level of lifted parcel … … 817 817 REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev) 818 818 REAL dplcldt(klon), dplcldr(klon) 819 c? . condm_con(klon,klev),conda_con(klon,klev),820 c? . mr_con(klon,klev),ep_con(klon,klev)821 c? . ,sadiab(klon,klev),wadiab(klon,klev)822 c--823 c34EK824 c 825 cVariables du changement826 c 827 ccon: convection828 clsc: condensation a grande echelle (Large-Scale-Condensation)829 cajs: ajustement sec830 ceva: evaporation de l'eau liquide nuageuse831 cvdf: couche limite (Vertical DiFfusion)819 !? . condm_con(klon,klev),conda_con(klon,klev), 820 !? . mr_con(klon,klev),ep_con(klon,klev) 821 !? . ,sadiab(klon,klev),wadiab(klon,klev) 822 ! -- 823 !34EK 824 ! 825 ! Variables du changement 826 ! 827 ! con: convection 828 ! lsc: condensation a grande echelle (Large-Scale-Condensation) 829 ! ajs: ajustement sec 830 ! eva: evaporation de l'eau liquide nuageuse 831 ! vdf: couche limite (Vertical DiFfusion) 832 832 833 833 ! tendance nulles 834 834 REAL du0(klon,klev),dv0(klon,klev),dq0(klon,klev),dql0(klon,klev) 835 835 836 c 837 *********************************************************838 *declarations836 ! 837 !******************************************************** 838 ! declarations 839 839 840 *********************************************************841 cIM 081204 END842 c 840 !******************************************************** 841 !IM 081204 END 842 ! 843 843 REAL pen_u(klon,klev), pen_d(klon,klev) 844 844 REAL pde_u(klon,klev), pde_d(klon,klev) 845 845 INTEGER kcbot(klon), kctop(klon), kdtop(klon) 846 c 846 ! 847 847 REAL ratqsc(klon,klev) 848 848 real ratqsbas,ratqshaut,tau_ratqs 849 849 save ratqsbas,ratqshaut,tau_ratqs 850 c$OMP THREADPRIVATE(ratqsbas,ratqshaut,tau_ratqs)850 !$OMP THREADPRIVATE(ratqsbas,ratqshaut,tau_ratqs) 851 851 real zpt_conv(klon,klev) 852 852 853 cParametres lies au nouveau schema de nuages (SB, PDF)853 ! Parametres lies au nouveau schema de nuages (SB, PDF) 854 854 real fact_cldcon 855 855 real facttemps 856 856 logical ok_newmicro 857 857 save ok_newmicro 858 c$OMP THREADPRIVATE(ok_newmicro)858 !$OMP THREADPRIVATE(ok_newmicro) 859 859 save fact_cldcon,facttemps 860 c$OMP THREADPRIVATE(fact_cldcon,facttemps)860 !$OMP THREADPRIVATE(fact_cldcon,facttemps) 861 861 862 862 integer iflag_cldcon 863 863 save iflag_cldcon 864 c$OMP THREADPRIVATE(iflag_cldcon)864 !$OMP THREADPRIVATE(iflag_cldcon) 865 865 logical ptconv(klon,klev) 866 cIM cf. AM 081204 BEG866 !IM cf. AM 081204 BEG 867 867 logical ptconvth(klon,klev) 868 cIM cf. AM 081204 END869 c 870 cVariables liees a l'ecriture de la bande histoire physique871 c 872 c======================================================================873 c 874 cIM cf. AM 081204 BEG875 cdeclarations pour sortir sur une sous-region868 !IM cf. AM 081204 END 869 ! 870 ! Variables liees a l'ecriture de la bande histoire physique 871 ! 872 !====================================================================== 873 ! 874 !IM cf. AM 081204 BEG 875 ! declarations pour sortir sur une sous-region 876 876 integer imin_ins,imax_ins,jmin_ins,jmax_ins 877 877 save imin_ins,imax_ins,jmin_ins,jmax_ins 878 c$OMP THREADPRIVATE(imin_ins,imax_ins,jmin_ins,jmax_ins)879 creal lonmin_ins,lonmax_ins,latmin_ins880 cs ,latmax_ins881 cdata lonmin_ins,lonmax_ins,latmin_ins882 cs ,latmax_ins/883 cvaleurs initiales s -5.,20.,41.,55./884 cs 100.,130.,-20.,20./885 cs -180.,180.,-90.,90./886 c======================================================================887 cIM cf. AM 081204 END888 889 c 878 !$OMP THREADPRIVATE(imin_ins,imax_ins,jmin_ins,jmax_ins) 879 ! real lonmin_ins,lonmax_ins,latmin_ins 880 ! s ,latmax_ins 881 ! data lonmin_ins,lonmax_ins,latmin_ins 882 ! s ,latmax_ins/ 883 ! valeurs initiales s -5.,20.,41.,55./ 884 ! s 100.,130.,-20.,20./ 885 ! s -180.,180.,-90.,90./ 886 !====================================================================== 887 !IM cf. AM 081204 END 888 889 ! 890 890 integer itau_w ! pas de temps ecriture = itap + itau_phy 891 c 892 c 893 cVariables locales pour effectuer les appels en serie894 c 895 cIM RH a 2m (la surface)891 ! 892 ! 893 ! Variables locales pour effectuer les appels en serie 894 ! 895 !IM RH a 2m (la surface) 896 896 REAL Lheat 897 897 … … 899 899 PARAMETER ( length = 100 ) 900 900 REAL tabcntr0( length ) 901 c 901 ! 902 902 INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev) 903 cIM903 !IM 904 904 INTEGER ndex2d1(iwmax) 905 c 906 cIM AMIP2 BEG905 ! 906 !IM AMIP2 BEG 907 907 REAL moyglo, mountor 908 cIM 141004 BEG908 !IM 141004 BEG 909 909 REAL zustrdr(klon), zvstrdr(klon) 910 910 REAL zustrli(klon), zvstrli(klon) … … 912 912 REAL zustrhi(klon), zvstrhi(klon) 913 913 REAL aam, torsfc 914 cIM 141004 END915 cIM 190504 BEG914 !IM 141004 END 915 !IM 190504 BEG 916 916 INTEGER ij, imp1jmp1 917 917 PARAMETER(imp1jmp1=(iim+1)*jjmp1) 918 cym A voir plus tard918 !ym A voir plus tard 919 919 REAL zx_tmp(imp1jmp1), airedyn(iim+1,jjmp1) 920 920 REAL padyn(iim+1,jjmp1,klev+1) 921 921 REAL dudyn(iim+1,jjmp1,klev) 922 922 REAL rlatdyn(iim+1,jjmp1) 923 cIM 190504 END923 !IM 190504 END 924 924 LOGICAL ok_msk 925 925 REAL msk(klon) 926 cIM926 !IM 927 927 REAL airetot, pi 928 cym A voir plus tard929 cym REAL zm_wo(jjmp1, klev)930 cIM AMIP2 END931 c 928 !ym A voir plus tard 929 !ym REAL zm_wo(jjmp1, klev) 930 !IM AMIP2 END 931 ! 932 932 REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique 933 933 REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D … … 936 936 REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev) 937 937 REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1) 938 c 938 ! 939 939 INTEGER nid_day, nid_mth, nid_ins, nid_mthnmc, nid_daynmc 940 940 INTEGER nid_hfnmc, nid_day_seri, nid_ctesGCM 941 941 SAVE nid_day, nid_mth, nid_ins, nid_mthnmc, nid_daynmc 942 942 SAVE nid_hfnmc, nid_day_seri, nid_ctesGCM 943 c$OMP THREADPRIVATE(nid_day, nid_mth, nid_ins)944 c$OMP THREADPRIVATE(nid_mthnmc, nid_daynmc, nid_hfnmc)945 c$OMP THREADPRIVATE(nid_day_seri,nid_ctesGCM)946 c 947 cIM 280405 BEG943 !$OMP THREADPRIVATE(nid_day, nid_mth, nid_ins) 944 !$OMP THREADPRIVATE(nid_mthnmc, nid_daynmc, nid_hfnmc) 945 !$OMP THREADPRIVATE(nid_day_seri,nid_ctesGCM) 946 ! 947 !IM 280405 BEG 948 948 INTEGER nid_bilKPins, nid_bilKPave 949 949 SAVE nid_bilKPins, nid_bilKPave 950 c$OMP THREADPRIVATE(nid_bilKPins, nid_bilKPave)951 c 950 !$OMP THREADPRIVATE(nid_bilKPins, nid_bilKPave) 951 ! 952 952 REAL ve_lay(klon,klev) ! transport meri. de l'energie a chaque niveau vert. 953 953 REAL vq_lay(klon,klev) ! transport meri. de l'eau a chaque niveau vert. 954 954 REAL ue_lay(klon,klev) ! transport zonal de l'energie a chaque niveau vert. 955 955 REAL uq_lay(klon,klev) ! transport zonal de l'eau a chaque niveau vert. 956 c 956 ! 957 957 INTEGER nhori, nvert, nvert1, nvert3 958 958 REAL zsto, zsto1, zsto2 … … 961 961 REAL zout_isccp(napisccp) 962 962 SAVE zcals, zcalh, zoutj, zout_isccp 963 c$OMP THREADPRIVATE(zcals, zcalh, zoutj, zout_isccp)963 !$OMP THREADPRIVATE(zcals, zcalh, zoutj, zout_isccp) 964 964 965 965 real zjulian 966 966 save zjulian 967 c$OMP THREADPRIVATE(zjulian)967 !$OMP THREADPRIVATE(zjulian) 968 968 969 969 character*20 modname … … 973 973 integer idayref 974 974 975 Cessai writephys975 ! essai writephys 976 976 integer fid_day, fid_mth, fid_ins 977 977 parameter (fid_ins = 1, fid_day = 2, fid_mth = 3) 978 978 integer prof2d_on, prof3d_on, prof2d_av, prof3d_av 979 parameter (prof2d_on = 1, prof3d_on = 2, 980 .prof2d_av = 3, prof3d_av = 4)979 parameter (prof2d_on = 1, prof3d_on = 2, & 980 prof2d_av = 3, prof3d_av = 4) 981 981 character*30 nom_fichier 982 982 character*40 varname 983 983 character*40 vartitle 984 984 character*20 varunits 985 CVariables liees au bilan d'energie et d'enthalpi985 ! Variables liees au bilan d'energie et d'enthalpi 986 986 REAL ztsol(klon) 987 REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot 988 $, h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot989 SAVE h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot 990 $, h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot991 c$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, 992 c$OMP+h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)987 REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot & 988 , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot 989 SAVE h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot & 990 , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot 991 !$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot) 992 !$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot) 993 993 REAL d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec 994 994 REAL d_h_vcol_phy 995 995 REAL fs_bound, fq_bound 996 996 SAVE d_h_vcol_phy 997 c$OMP THREADPRIVATE(d_h_vcol_phy)997 !$OMP THREADPRIVATE(d_h_vcol_phy) 998 998 REAL zero_v(klon) 999 999 CHARACTER*15 ztit … … 1001 1001 SAVE ip_ebil 1002 1002 DATA ip_ebil/0/ 1003 c$OMP THREADPRIVATE(ip_ebil)1003 !$OMP THREADPRIVATE(ip_ebil) 1004 1004 INTEGER if_ebil ! level for energy conserv. dignostics 1005 1005 SAVE if_ebil 1006 c$OMP THREADPRIVATE(if_ebil)1007 c+jld ec_conser1006 !$OMP THREADPRIVATE(if_ebil) 1007 !+jld ec_conser 1008 1008 REAL ZRCPD 1009 c-jld ec_conser1009 !-jld ec_conser 1010 1010 REAL q2m(klon,nbsrf) ! humidite a 2m 1011 1011 1012 cIM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels1012 !IM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels 1013 1013 CHARACTER*40 t2mincels, t2maxcels !t2m min., t2m max 1014 1014 CHARACTER*40 tinst, tave, typeval … … 1030 1030 REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995) 1031 1031 SAVE ok_ade, ok_aie, ok_cdnc, bl95_b0, bl95_b1 1032 c$OMP THREADPRIVATE(ok_ade, ok_aie, ok_cdnc, bl95_b0, bl95_b1)1032 !$OMP THREADPRIVATE(ok_ade, ok_aie, ok_cdnc, bl95_b0, bl95_b1) 1033 1033 LOGICAL, SAVE :: aerosol_couple ! true : calcul des aerosols dans INCA 1034 1034 ! false : lecture des aerosol dans un fichier 1035 c$OMP THREADPRIVATE(aerosol_couple)1035 !$OMP THREADPRIVATE(aerosol_couple) 1036 1036 INTEGER, SAVE :: flag_aerosol 1037 c$OMP THREADPRIVATE(flag_aerosol)1037 !$OMP THREADPRIVATE(flag_aerosol) 1038 1038 LOGICAL, SAVE :: new_aod 1039 c$OMP THREADPRIVATE(new_aod)1040 c 1041 c--STRAT AEROSOL1039 !$OMP THREADPRIVATE(new_aod) 1040 ! 1041 !--STRAT AEROSOL 1042 1042 LOGICAL, SAVE :: flag_aerosol_strat 1043 c$OMP THREADPRIVATE(flag_aerosol_strat)1044 cc-fin STRAT AEROSOL1045 c 1046 cDeclaration des constantes et des fonctions thermodynamiques1047 c 1043 !$OMP THREADPRIVATE(flag_aerosol_strat) 1044 !c-fin STRAT AEROSOL 1045 ! 1046 ! Declaration des constantes et des fonctions thermodynamiques 1047 ! 1048 1048 LOGICAL,SAVE :: first=.true. 1049 c$OMP THREADPRIVATE(first)1049 !$OMP THREADPRIVATE(first) 1050 1050 1051 1051 integer iunit 1052 1052 1053 1053 integer, save:: read_climoz ! read ozone climatology 1054 C(let it keep the default OpenMP shared attribute)1055 CAllowed values are 0, 1 and 21056 C0: do not read an ozone climatology1057 C1: read a single ozone climatology that will be used day and night1058 C2: read two ozone climatologies, the average day and night1059 Cclimatology and the daylight climatology1054 ! (let it keep the default OpenMP shared attribute) 1055 ! Allowed values are 0, 1 and 2 1056 ! 0: do not read an ozone climatology 1057 ! 1: read a single ozone climatology that will be used day and night 1058 ! 2: read two ozone climatologies, the average day and night 1059 ! climatology and the daylight climatology 1060 1060 1061 1061 integer, save:: ncid_climoz ! NetCDF file containing ozone climatologies 1062 C(let it keep the default OpenMP shared attribute)1062 ! (let it keep the default OpenMP shared attribute) 1063 1063 1064 1064 real, pointer, save:: press_climoz(:) 1065 C(let it keep the default OpenMP shared attribute)1065 ! (let it keep the default OpenMP shared attribute) 1066 1066 ! edges of pressure intervals for ozone climatologies, in Pa, in strictly 1067 1067 ! ascending order … … 1069 1069 integer, save:: co3i = 0 1070 1070 ! time index in NetCDF file of current ozone fields 1071 c$OMP THREADPRIVATE(co3i)1071 !$OMP THREADPRIVATE(co3i) 1072 1072 1073 1073 integer ro3i … … 1079 1079 #include "YOETHF.h" 1080 1080 #include "FCTTRE.h" 1081 cIM 100106 BEG : pouvoir sortir les ctes de la physique1081 !IM 100106 BEG : pouvoir sortir les ctes de la physique 1082 1082 #include "conema3.h" 1083 1083 #include "fisrtilp.h" 1084 1084 #include "nuage.h" 1085 1085 #include "compbl.h" 1086 cIM 100106 END : pouvoir sortir les ctes de la physique1087 c 1086 !IM 100106 END : pouvoir sortir les ctes de la physique 1087 ! 1088 1088 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1089 cDeclarations pour Simulateur COSP1090 c============================================================1089 ! Declarations pour Simulateur COSP 1090 !============================================================ 1091 1091 real :: mr_ozone(klon,klev) 1092 1092 1093 cIM sorties fichier 1D paramLMDZ_phy.nc1093 !IM sorties fichier 1D paramLMDZ_phy.nc 1094 1094 REAL :: zx_tmp_0d(1,1) 1095 1095 INTEGER, PARAMETER :: np=1 … … 1099 1099 REAL grain(1), gtsol(1), gt2m(1), gprw(1) 1100 1100 1101 cIM stations CFMIP1101 !IM stations CFMIP 1102 1102 INTEGER, SAVE :: nCFMIP 1103 c$OMP THREADPRIVATE(nCFMIP)1103 !$OMP THREADPRIVATE(nCFMIP) 1104 1104 INTEGER, PARAMETER :: npCFMIP=120 1105 1105 INTEGER, ALLOCATABLE, SAVE :: tabCFMIP(:) 1106 1106 REAL, ALLOCATABLE, SAVE :: lonCFMIP(:), latCFMIP(:) 1107 c$OMP THREADPRIVATE(tabCFMIP, lonCFMIP, latCFMIP)1107 !$OMP THREADPRIVATE(tabCFMIP, lonCFMIP, latCFMIP) 1108 1108 INTEGER, ALLOCATABLE, SAVE :: tabijGCM(:) 1109 1109 REAL, ALLOCATABLE, SAVE :: lonGCM(:), latGCM(:) 1110 c$OMP THREADPRIVATE(tabijGCM, lonGCM, latGCM)1110 !$OMP THREADPRIVATE(tabijGCM, lonGCM, latGCM) 1111 1111 INTEGER, ALLOCATABLE, SAVE :: iGCM(:), jGCM(:) 1112 c$OMP THREADPRIVATE(iGCM, jGCM)1112 !$OMP THREADPRIVATE(iGCM, jGCM) 1113 1113 logical, dimension(nfiles) :: phys_out_filestations 1114 1114 logical, parameter :: lNMC=.FALSE. 1115 1115 1116 cIM betaCRF1116 !IM betaCRF 1117 1117 REAL, SAVE :: pfree, beta_pbl, beta_free 1118 c$OMP THREADPRIVATE(pfree, beta_pbl, beta_free)1118 !$OMP THREADPRIVATE(pfree, beta_pbl, beta_free) 1119 1119 REAL, SAVE :: lon1_beta, lon2_beta, lat1_beta, lat2_beta 1120 c$OMP THREADPRIVATE(lon1_beta, lon2_beta, lat1_beta, lat2_beta)1120 !$OMP THREADPRIVATE(lon1_beta, lon2_beta, lat1_beta, lat2_beta) 1121 1121 LOGICAL, SAVE :: mskocean_beta 1122 c$OMP THREADPRIVATE(mskocean_beta)1122 !$OMP THREADPRIVATE(mskocean_beta) 1123 1123 REAL, dimension(klon, klev) :: beta ! facteur sur cldtaurad et cldemirad pour evaluer les retros liees aux CRF 1124 1124 REAL, dimension(klon, klev) :: cldtaurad ! epaisseur optique pour radlwsw pour tester "CRF off" … … 1131 1131 integer iostat 1132 1132 1133 c======================================================================1133 !====================================================================== 1134 1134 ! Gestion calendrier : mise a jour du module phys_cal_mod 1135 1135 ! 1136 1136 CALL phys_cal_update(jD_cur,jH_cur) 1137 1137 1138 c======================================================================1138 !====================================================================== 1139 1139 ! Ecriture eventuelle d'un profil verticale en entree de la physique. 1140 1140 ! Utilise notamment en 1D mais peut etre active egalement en 3D 1141 1141 ! en imposant la valeur de igout. 1142 c======================================================================d1142 !======================================================================d 1143 1143 if (prt_level.ge.1) then 1144 1144 igout=klon/2+1/klon 1145 1145 write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!' 1146 write(lunout,*) 1147 s'nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys'1148 write(lunout,*) 1149 snlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys1146 write(lunout,*) & 1147 'nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys' 1148 write(lunout,*) & 1149 nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys 1150 1150 1151 1151 write(lunout,*) 'paprs, play, phi, u, v, t' 1152 1152 do k=1,klev 1153 write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), 1154 su(igout,k),v(igout,k),t(igout,k)1153 write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), & 1154 u(igout,k),v(igout,k),t(igout,k) 1155 1155 enddo 1156 1156 write(lunout,*) 'ovap (g/kg), oliq (g/kg)' … … 1160 1160 endif 1161 1161 1162 c======================================================================1162 !====================================================================== 1163 1163 1164 1164 if (first) then 1165 1165 1166 cCR:nvelles variables convection/poches froides1166 !CR:nvelles variables convection/poches froides 1167 1167 1168 1168 print*, '=================================================' 1169 1169 print*, 'Allocation des variables locales et sauvegardees' 1170 1170 call phys_local_var_init 1171 c 1171 ! 1172 1172 pasphys=pdtphys 1173 cappel a la lecture du run.def physique1174 call conf_phys(ok_journe, ok_mensuel, 1175 . ok_instan, ok_hf,1176 . ok_LES,1177 . callstats,1178 . solarlong0,seuil_inversion,1179 . fact_cldcon, facttemps,ok_newmicro,iflag_radia,1180 . iflag_cldcon,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,1181 . ok_ade, ok_aie, ok_cdnc, aerosol_couple,1182 . flag_aerosol, flag_aerosol_strat, new_aod,1183 . bl95_b0, bl95_b1,1184 cnv flags pour la convection et les poches froides1185 . read_climoz,1186 &alp_offset)1173 ! appel a la lecture du run.def physique 1174 call conf_phys(ok_journe, ok_mensuel, & 1175 ok_instan, ok_hf, & 1176 ok_LES, & 1177 callstats, & 1178 solarlong0,seuil_inversion, & 1179 fact_cldcon, facttemps,ok_newmicro,iflag_radia, & 1180 iflag_cldcon,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, & 1181 ok_ade, ok_aie, ok_cdnc, aerosol_couple, & 1182 flag_aerosol, flag_aerosol_strat, new_aod, & 1183 bl95_b0, bl95_b1, & 1184 ! nv flags pour la convection et les poches froides 1185 read_climoz, & 1186 alp_offset) 1187 1187 call phys_state_var_init(read_climoz) 1188 1188 call phys_output_var_init 1189 1189 print*, '=================================================' 1190 c 1190 ! 1191 1191 dnwd0=0.0 1192 1192 ftd=0.0 1193 1193 fqd=0.0 1194 1194 cin=0. 1195 cym Attention pbase pas initialise dans concvl !!!!1195 !ym Attention pbase pas initialise dans concvl !!!! 1196 1196 pbase=0 1197 cIM 1806081197 !IM 180608 1198 1198 1199 1199 itau_con=0 … … 1202 1202 endif ! first 1203 1203 1204 cym => necessaire pour iflag_con != 21204 !ym => necessaire pour iflag_con != 2 1205 1205 pmfd(:,:) = 0. 1206 1206 pen_u(:,:) = 0. … … 1216 1216 1217 1217 modname = 'physiq' 1218 cIM1218 !IM 1219 1219 IF (ip_ebil_phy.ge.1) THEN 1220 1220 DO i=1,klon … … 1231 1231 1232 1232 1233 c======================================================================1233 !====================================================================== 1234 1234 ! Gestion calendrier : mise a jour du module phys_cal_mod 1235 1235 ! 1236 cCALL phys_cal_update(jD_cur,jH_cur)1237 1238 c 1239 cSi c'est le debut, il faut initialiser plusieurs choses1240 c********1241 c 1236 ! CALL phys_cal_update(jD_cur,jH_cur) 1237 1238 ! 1239 ! Si c'est le debut, il faut initialiser plusieurs choses 1240 ! ******** 1241 ! 1242 1242 IF (debut) THEN 1243 1243 !rv 1244 cCRinitialisation de wght_th et lalim_conv pour la definition de la couche alimentation1245 cde la convection a partir des caracteristiques du thermique1244 !CRinitialisation de wght_th et lalim_conv pour la definition de la couche alimentation 1245 !de la convection a partir des caracteristiques du thermique 1246 1246 wght_th(:,:)=1. 1247 1247 lalim_conv(:)=1 1248 cRC1248 !RC 1249 1249 ustar(:,:)=0. 1250 1250 u10m(:,:)=0. … … 1273 1273 clwcon(:,:) = 0.0 1274 1274 1275 cIM1275 !IM 1276 1276 IF (ip_ebil_phy.ge.1) d_h_vcol_phy=0. 1277 c 1278 print*,'iflag_coupl,iflag_clos,iflag_wake', 1279 .iflag_coupl,iflag_clos,iflag_wake1277 ! 1278 print*,'iflag_coupl,iflag_clos,iflag_wake', & 1279 iflag_coupl,iflag_clos,iflag_wake 1280 1280 print*,'CYCLE_DIURNE', cycle_diurne 1281 c 1281 ! 1282 1282 IF (iflag_con.EQ.2.AND.iflag_cldcon.GT.-1) THEN 1283 1283 abort_message = 'Tiedtke needs iflag_cldcon=-2 or -1' 1284 1284 CALL abort_gcm (modname,abort_message,1) 1285 1285 ENDIF 1286 c 1286 ! 1287 1287 IF(ok_isccp.AND.iflag_con.LE.2) THEN 1288 abort_message = 'ISCCP-like outputs may be available for KE 1289 .(iflag_con >= 3); for Tiedtke (iflag_con=-2) put ok_isccp=n'1288 abort_message = 'ISCCP-like outputs may be available for KE' // & 1289 '(iflag_con >= 3); for Tiedtke (iflag_con=-2) put ok_isccp=n' 1290 1290 CALL abort_gcm (modname,abort_message,1) 1291 1291 ENDIF 1292 c 1293 cInitialiser les compteurs:1294 c 1292 ! 1293 ! Initialiser les compteurs: 1294 ! 1295 1295 itap = 0 1296 1296 itaprad = 0 … … 1320 1320 PRINT*,'FH WARNING : lignes a supprimer' 1321 1321 ENDIF 1322 cIM begin1323 print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1) 1324 $,ratqs(1,1)1325 cIM end1322 !IM begin 1323 print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1) & 1324 ,ratqs(1,1) 1325 !IM end 1326 1326 1327 1327 1328 1328 1329 1329 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1330 c 1331 Con remet le calendrier a zero1332 c 1330 ! 1331 ! on remet le calendrier a zero 1332 ! 1333 1333 IF (raz_date .eq. 1) THEN 1334 1334 itau_phy = 0 1335 1335 ENDIF 1336 1336 1337 cIM cf. AM 081204 BEG1337 !IM cf. AM 081204 BEG 1338 1338 PRINT*,'cycle_diurne3 =',cycle_diurne 1339 cIM cf. AM 081204 END1340 c 1341 CALL printflag( tabcntr0,radpas,ok_journe, 1342 ,ok_instan, ok_region )1343 c 1339 !IM cf. AM 081204 END 1340 ! 1341 CALL printflag( tabcntr0,radpas,ok_journe, & 1342 ok_instan, ok_region ) 1343 ! 1344 1344 IF (ABS(dtime-pdtphys).GT.0.001) THEN 1345 WRITE(lunout,*) 'Pas physique n est pas correct',dtime, 1346 .pdtphys1345 WRITE(lunout,*) 'Pas physique n est pas correct',dtime, & 1346 pdtphys 1347 1347 abort_message='Pas physique n est pas correct ' 1348 1348 ! call abort_gcm(modname,abort_message,1) … … 1350 1350 ENDIF 1351 1351 IF (nlon .NE. klon) THEN 1352 WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, 1353 .klon1352 WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, & 1353 klon 1354 1354 abort_message='nlon et klon ne sont pas coherents' 1355 1355 call abort_gcm(modname,abort_message,1) 1356 1356 ENDIF 1357 1357 IF (nlev .NE. klev) THEN 1358 WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev, 1359 .klev1358 WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev, & 1359 klev 1360 1360 abort_message='nlev et klev ne sont pas coherents' 1361 1361 call abort_gcm(modname,abort_message,1) 1362 1362 ENDIF 1363 c 1363 ! 1364 1364 IF (dtime*REAL(radpas).GT.21600..AND.cycle_diurne) THEN 1365 1365 WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant' … … 1369 1369 ENDIF 1370 1370 WRITE(lunout,*)"Clef pour la convection, iflag_con=", iflag_con 1371 WRITE(lunout,*)"Clef pour le driver de la convection, ok_cvl=", 1372 .ok_cvl1373 c 1374 cKE431375 cInitialisation pour la convection de K.E. (sb):1371 WRITE(lunout,*)"Clef pour le driver de la convection, ok_cvl=", & 1372 ok_cvl 1373 ! 1374 !KE43 1375 ! Initialisation pour la convection de K.E. (sb): 1376 1376 IF (iflag_con.GE.3) THEN 1377 1377 1378 1378 WRITE(lunout,*)"*** Convection de Kerry Emanuel 4.3 " 1379 WRITE(lunout,*) 1380 ."On va utiliser le melange convectif des traceurs qui"1379 WRITE(lunout,*) & 1380 "On va utiliser le melange convectif des traceurs qui" 1381 1381 WRITE(lunout,*)"est calcule dans convect4.3" 1382 1382 WRITE(lunout,*)" !!! penser aux logical flags de phytrac" … … 1386 1386 ema_pcb(i) = 0. 1387 1387 ema_pct(i) = 0. 1388 cema_workcbmf(i) = 0.1388 ! ema_workcbmf(i) = 0. 1389 1389 ENDDO 1390 cIM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>BEG1390 !IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>BEG 1391 1391 DO i = 1, klon 1392 1392 ibas_con(i) = 1 1393 1393 itop_con(i) = 1 1394 1394 ENDDO 1395 cIM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>END1396 c===============================================================================1397 cCR:04.12.07: initialisations poches froides1398 cControle de ALE et ALP pour la fermeture convective (jyg)1395 !IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>END 1396 !=============================================================================== 1397 !CR:04.12.07: initialisations poches froides 1398 ! Controle de ALE et ALP pour la fermeture convective (jyg) 1399 1399 if (iflag_wake>=1) then 1400 CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr 1401 s,alp_bl_prescr, ale_bl_prescr)1402 c11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU)1403 cprint*,'apres ini_wake iflag_cldcon=', iflag_cldcon1400 CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr & 1401 ,alp_bl_prescr, ale_bl_prescr) 1402 ! 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU) 1403 ! print*,'apres ini_wake iflag_cldcon=', iflag_cldcon 1404 1404 endif 1405 1405 … … 1409 1409 enddo 1410 1410 1411 c================================================================================1412 cIM stations CFMIP1411 !================================================================================ 1412 !IM stations CFMIP 1413 1413 nCFMIP=npCFMIP 1414 OPEN(98,file='npCFMIP_param.data',status='old', 1415 $form='formatted',iostat=iostat)1414 OPEN(98,file='npCFMIP_param.data',status='old', & 1415 form='formatted',iostat=iostat) 1416 1416 if (iostat == 0) then 1417 1417 READ(98,*,end=998) nCFMIP … … 1426 1426 ENDIF 1427 1427 1428 c 1428 ! 1429 1429 ALLOCATE(tabCFMIP(nCFMIP)) 1430 1430 ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP)) … … 1432 1432 ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP)) 1433 1433 ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP)) 1434 c 1435 clecture des nCFMIP stations CFMIP, de leur numero1436 cet des coordonnees geographiques lonCFMIP, latCFMIP1437 c 1438 CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP, 1439 $lonCFMIP, latCFMIP)1440 c 1441 cidentification des1442 c1) coordonnees lonGCM, latGCM des points CFMIP dans la grille de LMDZ1443 c2) indices points tabijGCM de la grille physique 1d sur klon points1444 c3) indices iGCM, jGCM de la grille physique 2d1445 c 1446 CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, 1447 $tabijGCM, lonGCM, latGCM, iGCM, jGCM)1448 c 1434 ! 1435 ! lecture des nCFMIP stations CFMIP, de leur numero 1436 ! et des coordonnees geographiques lonCFMIP, latCFMIP 1437 ! 1438 CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP, & 1439 lonCFMIP, latCFMIP) 1440 ! 1441 ! identification des 1442 ! 1) coordonnees lonGCM, latGCM des points CFMIP dans la grille de LMDZ 1443 ! 2) indices points tabijGCM de la grille physique 1d sur klon points 1444 ! 3) indices iGCM, jGCM de la grille physique 2d 1445 ! 1446 CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, & 1447 tabijGCM, lonGCM, latGCM, iGCM, jGCM) 1448 ! 1449 1449 else 1450 1450 ALLOCATE(tabijGCM(0)) … … 1462 1462 ENDDO 1463 1463 1464 c34EK1464 !34EK 1465 1465 IF (ok_orodr) THEN 1466 1466 … … 1489 1489 ENDDO 1490 1490 ENDIF 1491 c 1492 c 1491 ! 1492 ! 1493 1493 lmt_pas = NINT(86400./dtime * 1.0) ! tous les jours 1494 WRITE(lunout,*)'La frequence de lecture surface est de ', 1495 .lmt_pas1496 c 1494 WRITE(lunout,*)'La frequence de lecture surface est de ', & 1495 lmt_pas 1496 ! 1497 1497 capemaxcels = 't_max(X)' 1498 1498 t2mincels = 't_min(X)' … … 1500 1500 tinst = 'inst(X)' 1501 1501 tave = 'ave(X)' 1502 cIM cf. AM 081204 BEG1502 !IM cf. AM 081204 BEG 1503 1503 write(lunout,*)'AVANT HIST IFLAG_CON=',iflag_con 1504 cIM cf. AM 081204 END1505 c 1506 c=============================================================1507 cInitialisation des sorties1508 c=============================================================1504 !IM cf. AM 081204 END 1505 ! 1506 !============================================================= 1507 ! Initialisation des sorties 1508 !============================================================= 1509 1509 1510 1510 #ifdef CPP_IOIPSL 1511 1511 1512 c$OMP MASTER1513 call phys_output_open(rlon,rlat,nCFMIP,tabijGCM, 1514 & iGCM,jGCM,lonGCM,latGCM,1515 & jjmp1,nlevSTD,clevSTD,rlevSTD,1516 & nbteta, ctetaSTD, dtime,ok_veget,1517 & type_ocean,iflag_pbl,ok_mensuel,ok_journe,1518 & ok_hf,ok_instan,ok_LES,ok_ade,ok_aie,1519 & read_climoz, phys_out_filestations,1520 & new_aod, aerosol_couple,1521 & flag_aerosol_strat, pdtphys, paprs, pphis,1522 & pplay, lmax_th, ptconv, ptconvth, ivap,1523 &d_t, qx, d_qx, zmasse, ok_sync)1524 c$OMP END MASTER1525 c$OMP BARRIER1512 !$OMP MASTER 1513 call phys_output_open(rlon,rlat,nCFMIP,tabijGCM, & 1514 iGCM,jGCM,lonGCM,latGCM, & 1515 jjmp1,nlevSTD,clevSTD,rlevSTD, & 1516 nbteta, ctetaSTD, dtime,ok_veget, & 1517 type_ocean,iflag_pbl,ok_mensuel,ok_journe, & 1518 ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, & 1519 read_climoz, phys_out_filestations, & 1520 new_aod, aerosol_couple, & 1521 flag_aerosol_strat, pdtphys, paprs, pphis, & 1522 pplay, lmax_th, ptconv, ptconvth, ivap, & 1523 d_t, qx, d_qx, zmasse, ok_sync) 1524 !$OMP END MASTER 1525 !$OMP BARRIER 1526 1526 1527 1527 #undef histISCCP … … 1538 1538 ecrit_tra = ecrit_tra * un_jour 1539 1539 1540 cXXXPB Positionner date0 pour initialisation de ORCHIDEE1540 !XXXPB Positionner date0 pour initialisation de ORCHIDEE 1541 1541 date0 = jD_ref 1542 1542 WRITE(*,*) 'physiq date0 : ',date0 1543 c 1544 c 1545 c 1546 cPrescrire l'ozone dans l'atmosphere1547 c 1548 c 1549 cc DO i = 1, klon1550 cc DO k = 1, klev1551 cc CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)1552 cc ENDDO1553 cc ENDDO1554 c 1543 ! 1544 ! 1545 ! 1546 ! Prescrire l'ozone dans l'atmosphere 1547 ! 1548 ! 1549 !c DO i = 1, klon 1550 !c DO k = 1, klev 1551 !c CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20) 1552 !c ENDDO 1553 !c ENDDO 1554 ! 1555 1555 IF (type_trac == 'inca') THEN 1556 1556 #ifdef INCA … … 1562 1562 WRITE(lunout,*) 'initial time chemini', days_elapsed, calday 1563 1563 1564 CALL chemini( 1565 $ rg,1566 $ ra,1567 $ airephy,1568 $ rlat,1569 $ rlon,1570 $ presnivs,1571 $ calday,1572 $ klon,1573 $ nqtot,1574 $ pdtphys,1575 $ annee_ref,1576 $ day_ref,1577 $itau_phy)1564 CALL chemini( & 1565 rg, & 1566 ra, & 1567 airephy, & 1568 rlat, & 1569 rlon, & 1570 presnivs, & 1571 calday, & 1572 klon, & 1573 nqtot, & 1574 pdtphys, & 1575 annee_ref, & 1576 day_ref, & 1577 itau_phy) 1578 1578 1579 1579 CALL VTe(VTinca) … … 1581 1581 #endif 1582 1582 END IF 1583 c 1584 c 1583 ! 1584 ! 1585 1585 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1586 1586 ! Nouvelle initialisation pour le rayonnement RRTM … … 1589 1589 call iniradia(klon,klev,paprs(1,1:klev+1)) 1590 1590 1591 C$omp single1591 !$omp single 1592 1592 if (read_climoz >= 1) then 1593 1593 call open_climoz(ncid_climoz, press_climoz) 1594 1594 END IF 1595 C$omp end single1596 c 1597 cIM betaCRF1595 !$omp end single 1596 ! 1597 !IM betaCRF 1598 1598 pfree=70000. !Pa 1599 1599 beta_pbl=1. … … 1605 1605 mskocean_beta=.FALSE. 1606 1606 1607 OPEN(99,file='beta_crf.data',status='old', 1608 $form='formatted',err=9999)1607 OPEN(99,file='beta_crf.data',status='old', & 1608 form='formatted',err=9999) 1609 1609 READ(99,*,end=9998) pfree 1610 1610 READ(99,*,end=9998) beta_pbl … … 1634 1634 ! 1635 1635 itap = itap + 1 1636 c 1636 ! 1637 1637 ! 1638 1638 ! Update fraction of the sub-surfaces (pctsrf) and … … 1640 1640 ! on the surface fraction. 1641 1641 ! 1642 CALL change_srf_frac(itap, dtime, days_elapsed+1, 1643 *pctsrf, falb1, falb2, ftsol, ustar, u10m, v10m, pbl_tke)1642 CALL change_srf_frac(itap, dtime, days_elapsed+1, & 1643 pctsrf, falb1, falb2, ftsol, ustar, u10m, v10m, pbl_tke) 1644 1644 1645 1645 … … 1660 1660 dq0(:,:)=0. 1661 1661 dql0(:,:)=0. 1662 c 1663 cMettre a zero des variables de sortie (pour securite)1664 c 1662 ! 1663 ! Mettre a zero des variables de sortie (pour securite) 1664 ! 1665 1665 DO i = 1, klon 1666 1666 d_ps(i) = 0.0 … … 1695 1695 ! RomP <<< 1696 1696 1697 c 1698 cNe pas affecter les valeurs entrees de u, v, h, et q1699 c 1697 ! 1698 ! Ne pas affecter les valeurs entrees de u, v, h, et q 1699 ! 1700 1700 DO k = 1, klev 1701 1701 DO i = 1, klon … … 1724 1724 ENDDO 1725 1725 ENDIF 1726 C 1726 ! 1727 1727 DO i = 1, klon 1728 1728 ztsol(i) = 0. … … 1733 1733 ENDDO 1734 1734 ENDDO 1735 cIM1735 !IM 1736 1736 IF (ip_ebil_phy.ge.1) THEN 1737 1737 ztit='after dynamic' 1738 CALL diagetpq(airephy,ztit,ip_ebil_phy,1,1,dtime 1739 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay1740 s, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)1741 CComme les tendances de la physique sont ajoute dans la dynamique,1742 Con devrait avoir que la variation d'entalpie par la dynamique1743 Cest egale a la variation de la physique au pas de temps precedent.1744 CDonc la somme de ces 2 variations devrait etre nulle.1745 call diagphy(airephy,ztit,ip_ebil_phy 1746 e , zero_v, zero_v, zero_v, zero_v, zero_v1747 e , zero_v, zero_v, zero_v, ztsol1748 e , d_h_vcol+d_h_vcol_phy, d_qt, 0.1749 s, fs_bound, fq_bound )1738 CALL diagetpq(airephy,ztit,ip_ebil_phy,1,1,dtime & 1739 , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay & 1740 , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 1741 ! Comme les tendances de la physique sont ajoute dans la dynamique, 1742 ! on devrait avoir que la variation d'entalpie par la dynamique 1743 ! est egale a la variation de la physique au pas de temps precedent. 1744 ! Donc la somme de ces 2 variations devrait etre nulle. 1745 call diagphy(airephy,ztit,ip_ebil_phy & 1746 , zero_v, zero_v, zero_v, zero_v, zero_v & 1747 , zero_v, zero_v, zero_v, ztsol & 1748 , d_h_vcol+d_h_vcol_phy, d_qt, 0. & 1749 , fs_bound, fq_bound ) 1750 1750 END IF 1751 1751 1752 cDiagnostiquer la tendance dynamique1753 c 1752 ! Diagnostiquer la tendance dynamique 1753 ! 1754 1754 IF (ancien_ok) THEN 1755 1755 DO k = 1, klev … … 1766 1766 DO k = 1, klev 1767 1767 DO i = 1, klon 1768 d_tr_dyn(i,k,iq-2)= 1769 $(tr_seri(i,k,iq-2)-tr_ancien(i,k,iq-2))/dtime1768 d_tr_dyn(i,k,iq-2)= & 1769 (tr_seri(i,k,iq-2)-tr_ancien(i,k,iq-2))/dtime 1770 1770 ! iiq=niadv(iq) 1771 1771 ! print*,i,k," d_tr_dyn",d_tr_dyn(i,k,iq-2),"tra:",iq,tname(iiq) … … 1797 1797 ancien_ok = .TRUE. 1798 1798 ENDIF 1799 c 1800 cAjouter le geopotentiel du sol:1801 c 1799 ! 1800 ! Ajouter le geopotentiel du sol: 1801 ! 1802 1802 DO k = 1, klev 1803 1803 DO i = 1, klon … … 1805 1805 ENDDO 1806 1806 ENDDO 1807 c 1808 cVerifier les temperatures1809 c 1810 cIM BEG1807 ! 1808 ! Verifier les temperatures 1809 ! 1810 !IM BEG 1811 1811 IF (check) THEN 1812 1812 amn=MIN(ftsol(1,is_ter),1000.) … … 1816 1816 amx=MAX(ftsol(i,is_ter),amx) 1817 1817 ENDDO 1818 c 1818 ! 1819 1819 PRINT*,' debut avant hgardfou min max ftsol',itap,amn,amx 1820 1820 ENDIF !(check) THEN 1821 cIM END1822 c 1821 !IM END 1822 ! 1823 1823 CALL hgardfou(t_seri,ftsol,'debutphy') 1824 c 1825 cIM BEG1824 ! 1825 !IM BEG 1826 1826 IF (check) THEN 1827 1827 amn=MIN(ftsol(1,is_ter),1000.) … … 1831 1831 amx=MAX(ftsol(i,is_ter),amx) 1832 1832 ENDDO 1833 c 1833 ! 1834 1834 PRINT*,' debut apres hgardfou min max ftsol',itap,amn,amx 1835 1835 ENDIF !(check) THEN 1836 cIM END1837 c 1838 cMettre en action les conditions aux limites (albedo, sst, etc.).1839 cPrescrire l'ozone et calculer l'albedo sur l'ocean.1840 c 1836 !IM END 1837 ! 1838 ! Mettre en action les conditions aux limites (albedo, sst, etc.). 1839 ! Prescrire l'ozone et calculer l'albedo sur l'ocean. 1840 ! 1841 1841 if (read_climoz >= 1) then 1842 COzone from a file1842 ! Ozone from a file 1843 1843 ! Update required ozone index: 1844 ro3i = int((days_elapsed + jh_cur - jh_1jan) 1845 $/ ioget_year_len(year_cur) * 360.) + 11844 ro3i = int((days_elapsed + jh_cur - jh_1jan) & 1845 / ioget_year_len(year_cur) * 360.) + 1 1846 1846 if (ro3i == 361) ro3i = 360 1847 C(This should never occur, except perhaps because of roundup1848 Cerror. See documentation.)1847 ! (This should never occur, except perhaps because of roundup 1848 ! error. See documentation.) 1849 1849 if (ro3i /= co3i) then 1850 CUpdate ozone field:1850 ! Update ozone field: 1851 1851 if (read_climoz == 1) then 1852 call regr_pr_av(ncid_climoz, (/"tro3"/), julien=ro3i, 1853 $press_in_edg=press_climoz, paprs=paprs, v3=wo)1852 call regr_pr_av(ncid_climoz, (/"tro3"/), julien=ro3i, & 1853 press_in_edg=press_climoz, paprs=paprs, v3=wo) 1854 1854 else 1855 Cread_climoz == 21856 call regr_pr_av(ncid_climoz, 1857 $ (/"tro3 ", "tro3_daylight"/),1858 $ julien=ro3i, press_in_edg=press_climoz, paprs=paprs,1859 $v3=wo)1855 ! read_climoz == 2 1856 call regr_pr_av(ncid_climoz, & 1857 (/"tro3 ", "tro3_daylight"/), & 1858 julien=ro3i, press_in_edg=press_climoz, paprs=paprs, & 1859 v3=wo) 1860 1860 end if 1861 1861 ! Convert from mole fraction of ozone to column density of ozone in a 1862 1862 ! cell, in kDU: 1863 forall (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l) 1864 $* rmo3 / rmd * zmasse / dobson_u / 1e31865 C(By regridding ozone values for LMDZ only once every 360th of1866 Cyear, we have already neglected the variation of pressure in one1867 C360th of year. So do not recompute "wo" at each time step even if1868 C"zmasse" changes a little.)1863 forall (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l) & 1864 * rmo3 / rmd * zmasse / dobson_u / 1e3 1865 ! (By regridding ozone values for LMDZ only once every 360th of 1866 ! year, we have already neglected the variation of pressure in one 1867 ! 360th of year. So do not recompute "wo" at each time step even if 1868 ! "zmasse" changes a little.) 1869 1869 co3i = ro3i 1870 1870 end if 1871 1871 elseif (MOD(itap-1,lmt_pas) == 0) THEN 1872 COnce per day, update ozone from Royer:1872 ! Once per day, update ozone from Royer: 1873 1873 wo(:, :, 1) = ozonecm(rlat, paprs, rjour=real(days_elapsed+1)) 1874 1874 ENDIF 1875 c 1876 cRe-evaporer l'eau liquide nuageuse1877 c 1875 ! 1876 ! Re-evaporer l'eau liquide nuageuse 1877 ! 1878 1878 DO k = 1, klev ! re-evaporation de l'eau liquide nuageuse 1879 1879 DO i = 1, klon 1880 1880 zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k)) 1881 cjyg<1882 cAttention : Arnaud a propose des formules completement differentes1883 cA verifier !!!1881 !jyg< 1882 ! Attention : Arnaud a propose des formules completement differentes 1883 ! A verifier !!! 1884 1884 zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k)) 1885 1885 IF (iflag_ice_thermo .EQ. 0) THEN 1886 1886 zlsdcp=zlvdcp 1887 1887 ENDIF 1888 c>jyg1888 !>jyg 1889 1889 1890 1890 zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k))) 1891 1891 zb = MAX(0.0,ql_seri(i,k)) 1892 za = - MAX(0.0,ql_seri(i,k)) 1893 .* (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)1892 za = - MAX(0.0,ql_seri(i,k)) & 1893 * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta) 1894 1894 t_seri(i,k) = t_seri(i,k) + za 1895 1895 q_seri(i,k) = q_seri(i,k) + zb … … 1899 1899 ENDDO 1900 1900 ENDDO 1901 cIM1901 !IM 1902 1902 IF (ip_ebil_phy.ge.2) THEN 1903 1903 ztit='after reevap' 1904 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,1,dtime 1905 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay1906 s, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)1907 call diagphy(airephy,ztit,ip_ebil_phy 1908 e , zero_v, zero_v, zero_v, zero_v, zero_v1909 e , zero_v, zero_v, zero_v, ztsol1910 e , d_h_vcol, d_qt, d_ec1911 s, fs_bound, fq_bound )1912 C 1904 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,1,dtime & 1905 , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay & 1906 , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 1907 call diagphy(airephy,ztit,ip_ebil_phy & 1908 , zero_v, zero_v, zero_v, zero_v, zero_v & 1909 , zero_v, zero_v, zero_v, ztsol & 1910 , d_h_vcol, d_qt, d_ec & 1911 , fs_bound, fq_bound ) 1912 ! 1913 1913 END IF 1914 1914 1915 c 1916 c=========================================================================1915 ! 1916 !========================================================================= 1917 1917 ! Calculs de l'orbite. 1918 1918 ! Necessaires pour le rayonnement et la surface (calcul de l'albedo). … … 1938 1938 endif 1939 1939 if(prt_level.ge.1) & 1940 &write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist1940 write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist 1941 1941 1942 1942 … … 1967 1967 endif 1968 1968 1969 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc1970 cAppel au pbl_surface : Planetary Boudary Layer et Surface1971 cCela implique tous les interactions des sous-surfaces et la partie diffusion1972 cturbulent du couche limit.1973 c1974 cCertains varibales de sorties de pbl_surface sont utiliser que pour1975 cecriture des fihiers hist_XXXX.nc, ces sont :1976 cqsol, zq2m, s_pblh, s_lcl,1977 cs_capCL, s_oliqCL, s_cteiCL,s_pblT,1978 cs_therm, s_trmb1, s_trmb2, s_trmb3,1979 czxrugs, zu10m, zv10m, fder,1980 czxqsurf, rh2m, zxfluxu, zxfluxv,1981 cfrugs, agesno, fsollw, fsolsw,1982 cd_ts, fevap, fluxlat, t2m,1983 cwfbils, wfbilo, fluxt, fluxu, fluxv,1984 c 1985 cCertains ne sont pas utiliser du tout :1986 cdsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq1987 c 1988 1989 cCalcul de l'humidite de saturation au niveau du sol1969 !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 1970 ! Appel au pbl_surface : Planetary Boudary Layer et Surface 1971 ! Cela implique tous les interactions des sous-surfaces et la partie diffusion 1972 ! turbulent du couche limit. 1973 ! 1974 ! Certains varibales de sorties de pbl_surface sont utiliser que pour 1975 ! ecriture des fihiers hist_XXXX.nc, ces sont : 1976 ! qsol, zq2m, s_pblh, s_lcl, 1977 ! s_capCL, s_oliqCL, s_cteiCL,s_pblT, 1978 ! s_therm, s_trmb1, s_trmb2, s_trmb3, 1979 ! zxrugs, zu10m, zv10m, fder, 1980 ! zxqsurf, rh2m, zxfluxu, zxfluxv, 1981 ! frugs, agesno, fsollw, fsolsw, 1982 ! d_ts, fevap, fluxlat, t2m, 1983 ! wfbils, wfbilo, fluxt, fluxu, fluxv, 1984 ! 1985 ! Certains ne sont pas utiliser du tout : 1986 ! dsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq 1987 ! 1988 1989 ! Calcul de l'humidite de saturation au niveau du sol 1990 1990 1991 1991 … … 1993 1993 if (iflag_pbl/=0) then 1994 1994 1995 CALL pbl_surface( 1996 e dtime, date0, itap, days_elapsed+1,1997 e debut, lafin,1998 e rlon, rlat, rugoro, rmu0,1999 e rain_fall, snow_fall, solsw, sollw,2000 e t_seri, q_seri, u_seri, v_seri,2001 e pplay, paprs, pctsrf,2002 + ftsol,falb1,falb2,ustar,u10m,v10m,wstar,2003 s sollwdown, cdragh, cdragm, u1, v1,2004 s albsol1, albsol2, sens, evap,2005 s zxtsol, zxfluxlat, zt2m, qsat2m,2006 s d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_t_diss,2007 s coefh, coefm, slab_wfbils,2008 d qsol, zq2m, s_pblh, s_lcl,2009 d s_capCL, s_oliqCL, s_cteiCL,s_pblT,2010 d s_therm, s_trmb1, s_trmb2, s_trmb3,2011 d zxrugs, zustar, zu10m, zv10m, fder,2012 d zxqsurf, rh2m, zxfluxu, zxfluxv,2013 d frugs, agesno, fsollw, fsolsw,2014 d d_ts, fevap, fluxlat, t2m,2015 d wfbils, wfbilo, fluxt, fluxu, fluxv,2016 - dsens, devap, zxsnow,2017 -zxfluxt, zxfluxq, q2m, fluxq, pbl_tke )1995 CALL pbl_surface( & 1996 dtime, date0, itap, days_elapsed+1, & 1997 debut, lafin, & 1998 rlon, rlat, rugoro, rmu0, & 1999 rain_fall, snow_fall, solsw, sollw, & 2000 t_seri, q_seri, u_seri, v_seri, & 2001 pplay, paprs, pctsrf, & 2002 ftsol,falb1,falb2,ustar,u10m,v10m,wstar, & 2003 sollwdown, cdragh, cdragm, u1, v1, & 2004 albsol1, albsol2, sens, evap, & 2005 zxtsol, zxfluxlat, zt2m, qsat2m, & 2006 d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_t_diss, & 2007 coefh, coefm, slab_wfbils, & 2008 qsol, zq2m, s_pblh, s_lcl, & 2009 s_capCL, s_oliqCL, s_cteiCL,s_pblT, & 2010 s_therm, s_trmb1, s_trmb2, s_trmb3, & 2011 zxrugs, zustar, zu10m, zv10m, fder, & 2012 zxqsurf, rh2m, zxfluxu, zxfluxv, & 2013 frugs, agesno, fsollw, fsolsw, & 2014 d_ts, fevap, fluxlat, t2m, & 2015 wfbils, wfbilo, fluxt, fluxu, fluxv, & 2016 dsens, devap, zxsnow, & 2017 zxfluxt, zxfluxq, q2m, fluxq, pbl_tke ) 2018 2018 2019 2019 2020 2020 !----------------------------------------------------------------------------------------- 2021 2021 ! ajout des tendances de la diffusion turbulente 2022 CALL add_phys_tend 2023 s(d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,'vdf')2022 CALL add_phys_tend & 2023 (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,'vdf') 2024 2024 !----------------------------------------------------------------------------------------- 2025 2025 … … 2031 2031 endif 2032 2032 2033 CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, 2034 et_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),evap_pot)2033 CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, & 2034 t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),evap_pot) 2035 2035 2036 2036 2037 2037 IF (ip_ebil_phy.ge.2) THEN 2038 2038 ztit='after surface_main' 2039 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime 2040 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay2041 s, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)2042 call diagphy(airephy,ztit,ip_ebil_phy 2043 e , zero_v, zero_v, zero_v, zero_v, sens2044 e , evap , zero_v, zero_v, ztsol2045 e , d_h_vcol, d_qt, d_ec2046 s, fs_bound, fq_bound )2039 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime & 2040 , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay & 2041 , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 2042 call diagphy(airephy,ztit,ip_ebil_phy & 2043 , zero_v, zero_v, zero_v, zero_v, sens & 2044 , evap , zero_v, zero_v, ztsol & 2045 , d_h_vcol, d_qt, d_ec & 2046 , fs_bound, fq_bound ) 2047 2047 END IF 2048 2048 2049 2049 ENDIF 2050 c=================================================================== c2051 cCalcul de Qsat2050 ! =================================================================== c 2051 ! Calcul de Qsat 2052 2052 2053 2053 DO k = 1, klev … … 2075 2075 write(lunout,'(i4,f15.4)') (k,1000.*zqsat(igout,k),k=1,klev) 2076 2076 endif 2077 c 2078 cAppeler la convection (au choix)2079 c 2077 ! 2078 ! Appeler la convection (au choix) 2079 ! 2080 2080 DO k = 1, klev 2081 2081 DO i = 1, klon 2082 conv_q(i,k) = d_q_dyn(i,k) 2083 .+ d_q_vdf(i,k)/dtime2084 conv_t(i,k) = d_t_dyn(i,k) 2085 .+ d_t_vdf(i,k)/dtime2082 conv_q(i,k) = d_q_dyn(i,k) & 2083 + d_q_vdf(i,k)/dtime 2084 conv_t(i,k) = d_t_dyn(i,k) & 2085 + d_t_vdf(i,k)/dtime 2086 2086 ENDDO 2087 2087 ENDDO … … 2098 2098 DO k = 1, klev 2099 2099 DO i = 1, klon 2100 z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k)) 2101 .*(paprs(i,k)-paprs(i,k+1))/RG2100 z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k)) & 2101 *(paprs(i,k)-paprs(i,k+1))/RG 2102 2102 ENDDO 2103 2103 ENDDO 2104 2104 ENDIF 2105 2105 2106 cCalcule de vitesse verticale a partir de flux de masse verticale2106 ! Calcule de vitesse verticale a partir de flux de masse verticale 2107 2107 DO k = 1, klev 2108 2108 DO i = 1, klon … … 2110 2110 END DO 2111 2111 END DO 2112 if (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ', 2113 $omega(igout, :)2112 if (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ', & 2113 omega(igout, :) 2114 2114 2115 2115 IF (iflag_con.EQ.1) THEN 2116 2116 abort_message ='reactiver le call conlmd dans physiq.F' 2117 2117 CALL abort_gcm (modname,abort_message,1) 2118 cCALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,2119 c. d_t_con, d_q_con,2120 c. rain_con, snow_con, ibas_con, itop_con)2118 ! CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q, 2119 ! . d_t_con, d_q_con, 2120 ! . rain_con, snow_con, ibas_con, itop_con) 2121 2121 ELSE IF (iflag_con.EQ.2) THEN 2122 CALL conflx(dtime, paprs, pplay, t_seri, q_seri, 2123 e conv_t, conv_q, -evap, omega,2124 s d_t_con, d_q_con, rain_con, snow_con,2125 s pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,2126 skcbot, kctop, kdtop, pmflxr, pmflxs)2122 CALL conflx(dtime, paprs, pplay, t_seri, q_seri, & 2123 conv_t, conv_q, -evap, omega, & 2124 d_t_con, d_q_con, rain_con, snow_con, & 2125 pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & 2126 kcbot, kctop, kdtop, pmflxr, pmflxs) 2127 2127 d_u_con = 0. 2128 2128 d_v_con = 0. … … 2135 2135 ENDDO 2136 2136 ELSE IF (iflag_con.GE.3) THEN 2137 cnb of tracers for the KE convection:2138 cMAF la partie traceurs est faite dans phytrac2139 con met ntra=1 pour limiter les appels mais on peut2140 csupprimer les calculs / ftra.2137 ! nb of tracers for the KE convection: 2138 ! MAF la partie traceurs est faite dans phytrac 2139 ! on met ntra=1 pour limiter les appels mais on peut 2140 ! supprimer les calculs / ftra. 2141 2141 ntra = 1 2142 2142 2143 c=====================================================================================2144 cajout pour la parametrisation des poches froides:2145 ccalcul de t_wake et t_undi: si pas de poches froides, t_wake=t_undi=t_seri2143 !===================================================================================== 2144 !ajout pour la parametrisation des poches froides: 2145 !calcul de t_wake et t_undi: si pas de poches froides, t_wake=t_undi=t_seri 2146 2146 do k=1,klev 2147 2147 do i=1,klon 2148 2148 if (iflag_wake>=1) then 2149 t_wake(i,k) = t_seri(i,k) 2150 .+(1-wake_s(i))*wake_deltat(i,k)2151 q_wake(i,k) = q_seri(i,k) 2152 .+(1-wake_s(i))*wake_deltaq(i,k)2153 t_undi(i,k) = t_seri(i,k) 2154 .-wake_s(i)*wake_deltat(i,k)2155 q_undi(i,k) = q_seri(i,k) 2156 .-wake_s(i)*wake_deltaq(i,k)2149 t_wake(i,k) = t_seri(i,k) & 2150 +(1-wake_s(i))*wake_deltat(i,k) 2151 q_wake(i,k) = q_seri(i,k) & 2152 +(1-wake_s(i))*wake_deltaq(i,k) 2153 t_undi(i,k) = t_seri(i,k) & 2154 -wake_s(i)*wake_deltat(i,k) 2155 q_undi(i,k) = q_seri(i,k) & 2156 -wake_s(i)*wake_deltaq(i,k) 2157 2157 else 2158 2158 t_wake(i,k) = t_seri(i,k) … … 2164 2164 enddo 2165 2165 2166 cc-- Calcul de l'energie disponible ALE (J/kg) et de la puissance disponible ALP (W/m2)2167 cc-- pour le soulevement des particules dans le modele convectif2168 c 2166 !c-- Calcul de l'energie disponible ALE (J/kg) et de la puissance disponible ALP (W/m2) 2167 !c-- pour le soulevement des particules dans le modele convectif 2168 ! 2169 2169 do i = 1,klon 2170 2170 ALE(i) = 0. 2171 2171 ALP(i) = 0. 2172 2172 enddo 2173 c 2174 ccalcul de ale_wake et alp_wake2173 ! 2174 !calcul de ale_wake et alp_wake 2175 2175 if (iflag_wake>=1) then 2176 2176 if (itap .le. it_wape_prescr) then … … 2181 2181 else 2182 2182 do i = 1,klon 2183 cjyg ALE=WAPE au lieu de ALE = 1/2 Cstar**22184 ccc ale_wake(i) = 0.5*wake_cstar(i)**22183 !jyg ALE=WAPE au lieu de ALE = 1/2 Cstar**2 2184 !cc ale_wake(i) = 0.5*wake_cstar(i)**2 2185 2185 ale_wake(i) = wake_pe(i) 2186 2186 alp_wake(i) = wake_fip(i) … … 2193 2193 enddo 2194 2194 endif 2195 ccombinaison avec ale et alp de couche limite: constantes si pas de couplage, valeurs calculees2196 cdans le thermique sinon2195 !combinaison avec ale et alp de couche limite: constantes si pas de couplage, valeurs calculees 2196 !dans le thermique sinon 2197 2197 if (iflag_coupl.eq.0) then 2198 if (debut.and.prt_level.gt.9) 2199 $WRITE(lunout,*)'ALE et ALP imposes'2198 if (debut.and.prt_level.gt.9) & 2199 WRITE(lunout,*)'ALE et ALP imposes' 2200 2200 do i = 1,klon 2201 con ne couple que ale2202 cALE(i) = max(ale_wake(i),Ale_bl(i))2201 !on ne couple que ale 2202 ! ALE(i) = max(ale_wake(i),Ale_bl(i)) 2203 2203 ALE(i) = max(ale_wake(i),ale_bl_prescr) 2204 con ne couple que alp2205 cALP(i) = alp_wake(i) + Alp_bl(i)2204 !on ne couple que alp 2205 ! ALP(i) = alp_wake(i) + Alp_bl(i) 2206 2206 ALP(i) = alp_wake(i) + alp_bl_prescr 2207 2207 enddo … … 2223 2223 do i = 1,klon 2224 2224 ALE(i) = max(ale_wake(i),Ale_bl(i)) 2225 ccc nrlmd le 10/04/2012----------Stochastic triggering--------------2225 !cc nrlmd le 10/04/2012----------Stochastic triggering-------------- 2226 2226 if (iflag_trig_bl.ge.1) then 2227 2227 ALE(i) = max(ale_wake(i),Ale_bl_trig(i)) 2228 2228 endif 2229 ccc fin nrlmd le 10/04/20122229 !cc fin nrlmd le 10/04/2012 2230 2230 if (alp_offset>=0.) then 2231 2231 ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb … … 2233 2233 ALP(i)=alp_wake(i)+Alp_bl(i)+alp_offset*min(omega(i,6),0.) 2234 2234 if (alp(i)<0.) then 2235 print*,'ALP ',alp(i),alp_wake(i) 2236 s,Alp_bl(i),alp_offset*min(omega(i,6),0.)2235 print*,'ALP ',alp(i),alp_wake(i) & 2236 ,Alp_bl(i),alp_offset*min(omega(i,6),0.) 2237 2237 endif 2238 2238 endif … … 2244 2244 if (alp(i)>alp_max) then 2245 2245 IF(prt_level>9)WRITE(lunout,*) & 2246 & 'WARNING SUPER ALP (seuil=',alp_max,2247 ,'): i, alp, alp_wake,ale',i,alp(i),alp_wake(i),ale(i)2246 'WARNING SUPER ALP (seuil=',alp_max, & 2247 '): i, alp, alp_wake,ale',i,alp(i),alp_wake(i),ale(i) 2248 2248 alp(i)=alp_max 2249 2249 endif 2250 2250 if (ale(i)>ale_max) then 2251 2251 IF(prt_level>9)WRITE(lunout,*) & 2252 & 'WARNING SUPER ALE (seuil=',ale_max,2253 ,'): i, alp, alp_wake,ale',i,ale(i),ale_wake(i),alp(i)2252 'WARNING SUPER ALE (seuil=',ale_max, & 2253 '): i, alp, alp_wake,ale',i,ale(i),ale_wake(i),alp(i) 2254 2254 ale(i)=ale_max 2255 2255 endif 2256 2256 enddo 2257 2257 2258 cfin calcul ale et alp2259 c=================================================================================================2260 2261 2262 csb, oct02:2263 cSchema de convection modularise et vectorise:2264 c(driver commun aux versions 3 et 4)2265 c 2258 !fin calcul ale et alp 2259 !================================================================================================= 2260 2261 2262 ! sb, oct02: 2263 ! Schema de convection modularise et vectorise: 2264 ! (driver commun aux versions 3 et 4) 2265 ! 2266 2266 IF (ok_cvl) THEN ! new driver for convectL 2267 2267 … … 2271 2271 nbtr_tmp=nbtr 2272 2272 END IF 2273 cjyg iflag_con est dans clesphys2274 cc CALL concvl (iflag_con,iflag_clos,2275 CALL concvl (iflag_clos, 2276 . dtime,paprs,pplay,t_undi,q_undi,2277 . t_wake,q_wake,wake_s,2278 . u_seri,v_seri,tr_seri,nbtr_tmp,2279 . ALE,ALP,2280 . sig1,w01,2281 . d_t_con,d_q_con,d_u_con,d_v_con,d_tr,2282 . rain_con, snow_con, ibas_con, itop_con, sigd,2283 . ema_cbmf,plcl,plfc,wbeff,upwd,dnwd,dnwd0,2284 . Ma,mip,Vprecip,cape,cin,tvp,Tconv,iflagctrl,2285 . pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd,2273 !jyg iflag_con est dans clesphys 2274 !c CALL concvl (iflag_con,iflag_clos, 2275 CALL concvl (iflag_clos, & 2276 dtime,paprs,pplay,t_undi,q_undi, & 2277 t_wake,q_wake,wake_s, & 2278 u_seri,v_seri,tr_seri,nbtr_tmp, & 2279 ALE,ALP, & 2280 sig1,w01, & 2281 d_t_con,d_q_con,d_u_con,d_v_con,d_tr, & 2282 rain_con, snow_con, ibas_con, itop_con, sigd, & 2283 ema_cbmf,plcl,plfc,wbeff,upwd,dnwd,dnwd0, & 2284 Ma,mip,Vprecip,cape,cin,tvp,Tconv,iflagctrl, & 2285 pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd, & 2286 2286 ! RomP >>> 2287 2287 !! . pmflxr,pmflxs,da,phi,mp, 2288 2288 !! . ftd,fqd,lalim_conv,wght_th) 2289 . pmflxr,pmflxs,da,phi,mp,phi2,d1a,dam,sij,clw,elij,2290 . ftd,fqd,lalim_conv,wght_th,2291 . ev, ep,epmlmMm,eplaMm,2292 .wdtrainA,wdtrainM)2289 pmflxr,pmflxs,da,phi,mp,phi2,d1a,dam,sij,clw,elij, & 2290 ftd,fqd,lalim_conv,wght_th, & 2291 ev, ep,epmlmMm,eplaMm, & 2292 wdtrainA,wdtrainM) 2293 2293 ! RomP <<< 2294 2294 2295 cIM begin2296 cprint*,'physiq: cin pbase dnwd0 ftd fqd ',cin(1),pbase(1),2297 c.dnwd0(1,1),ftd(1,1),fqd(1,1)2298 cIM end2299 cIM cf. FH2295 !IM begin 2296 ! print*,'physiq: cin pbase dnwd0 ftd fqd ',cin(1),pbase(1), 2297 ! .dnwd0(1,1),ftd(1,1),fqd(1,1) 2298 !IM end 2299 !IM cf. FH 2300 2300 clwcon0=qcondc 2301 2301 pmfu(:,:)=upwd(:,:)+dnwd(:,:) … … 2307 2307 ELSE ! ok_cvl 2308 2308 2309 cMAF conema3 ne contient pas les traceurs2310 CALL conema3 (dtime, 2311 . paprs,pplay,t_seri,q_seri,2312 . u_seri,v_seri,tr_seri,ntra,2313 . sig1,w01,2314 . d_t_con,d_q_con,d_u_con,d_v_con,d_tr,2315 . rain_con, snow_con, ibas_con, itop_con,2316 . upwd,dnwd,dnwd0,bas,top,2317 . Ma,cape,tvp,rflag,2318 . pbase2319 . ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr2320 .,clwcon0)2309 ! MAF conema3 ne contient pas les traceurs 2310 CALL conema3 (dtime, & 2311 paprs,pplay,t_seri,q_seri, & 2312 u_seri,v_seri,tr_seri,ntra, & 2313 sig1,w01, & 2314 d_t_con,d_q_con,d_u_con,d_v_con,d_tr, & 2315 rain_con, snow_con, ibas_con, itop_con, & 2316 upwd,dnwd,dnwd0,bas,top, & 2317 Ma,cape,tvp,rflag, & 2318 pbase & 2319 ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr & 2320 ,clwcon0) 2321 2321 2322 2322 ENDIF ! ok_cvl 2323 2323 2324 c 2325 cCorrection precip2324 ! 2325 ! Correction precip 2326 2326 rain_con = rain_con * cvl_corr 2327 2327 snow_con = snow_con * cvl_corr 2328 c 2328 ! 2329 2329 2330 2330 IF (.NOT. ok_gust) THEN … … 2334 2334 ENDIF 2335 2335 2336 c=================================================================== c2337 cCalcul des proprietes des nuages convectifs2338 c 2339 2340 ccalcul des proprietes des nuages convectifs2336 ! =================================================================== c 2337 ! Calcul des proprietes des nuages convectifs 2338 ! 2339 2340 ! calcul des proprietes des nuages convectifs 2341 2341 clwcon0(:,:)=fact_cldcon*clwcon0(:,:) 2342 call clouds_gno 2343 s(klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)2344 2345 c=================================================================== c2342 call clouds_gno & 2343 (klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0) 2344 2345 ! =================================================================== c 2346 2346 2347 2347 DO i = 1, klon … … 2382 2382 ENDIF 2383 2383 2384 cCALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,2385 c. d_u_con, d_v_con)2384 ! CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri, 2385 ! . d_u_con, d_v_con) 2386 2386 2387 2387 !----------------------------------------------------------------------------------------- … … 2397 2397 endif 2398 2398 2399 cIM2399 !IM 2400 2400 IF (ip_ebil_phy.ge.2) THEN 2401 2401 ztit='after convect' 2402 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime 2403 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay2404 s, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)2405 call diagphy(airephy,ztit,ip_ebil_phy 2406 e , zero_v, zero_v, zero_v, zero_v, zero_v2407 e , zero_v, rain_con, snow_con, ztsol2408 e , d_h_vcol, d_qt, d_ec2409 s, fs_bound, fq_bound )2402 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime & 2403 , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay & 2404 , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 2405 call diagphy(airephy,ztit,ip_ebil_phy & 2406 , zero_v, zero_v, zero_v, zero_v, zero_v & 2407 , zero_v, rain_con, snow_con, ztsol & 2408 , d_h_vcol, d_qt, d_ec & 2409 , fs_bound, fq_bound ) 2410 2410 END IF 2411 C 2411 ! 2412 2412 IF (check) THEN 2413 2413 za = qcheck(klon,klev,paprs,q_seri,ql_seri,airephy) … … 2417 2417 DO i = 1, klon 2418 2418 za = za + airephy(i)/REAL(klon) 2419 zx_t = zx_t + (rain_con(i)+ 2420 .snow_con(i))*airephy(i)/REAL(klon)2419 zx_t = zx_t + (rain_con(i)+ & 2420 snow_con(i))*airephy(i)/REAL(klon) 2421 2421 ENDDO 2422 2422 zx_t = zx_t/za*dtime … … 2429 2429 DO k = 1, klev 2430 2430 DO i = 1, klon 2431 z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) 2432 .*(paprs(i,k)-paprs(i,k+1))/RG2431 z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) & 2432 *(paprs(i,k)-paprs(i,k+1))/RG 2433 2433 ENDDO 2434 2434 ENDDO 2435 2435 DO i = 1, klon 2436 z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) 2437 ./z_apres(i)2436 z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) & 2437 /z_apres(i) 2438 2438 ENDDO 2439 2439 DO k = 1, klev 2440 2440 DO i = 1, klon 2441 IF (z_factor(i).GT.(1.0+1.0E-08) .OR. 2442 .z_factor(i).LT.(1.0-1.0E-08)) THEN2441 IF (z_factor(i).GT.(1.0+1.0E-08) .OR. & 2442 z_factor(i).LT.(1.0-1.0E-08)) THEN 2443 2443 q_seri(i,k) = q_seri(i,k) * z_factor(i) 2444 2444 ENDIF … … 2448 2448 zx_ajustq=.FALSE. 2449 2449 2450 c 2451 c=============================================================================2452 cRR:Evolution de la poche froide: on ne fait pas de separation wake/env2453 cpour la couche limite diffuse pour l instant2454 c 2450 ! 2451 !============================================================================= 2452 !RR:Evolution de la poche froide: on ne fait pas de separation wake/env 2453 !pour la couche limite diffuse pour l instant 2454 ! 2455 2455 if (iflag_wake>=1) then 2456 2456 DO k=1,klev … … 2472 2472 ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.) 2473 2473 DO k = 1,klev 2474 dt_dwn(:,k)= dt_dwn(:,k)+ 2475 :ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/dtime2476 dq_dwn(:,k)= dq_dwn(:,k)+ 2477 :ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/dtime2474 dt_dwn(:,k)= dt_dwn(:,k)+ & 2475 ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/dtime 2476 dq_dwn(:,k)= dq_dwn(:,k)+ & 2477 ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/dtime 2478 2478 ENDDO 2479 2479 endif 2480 c 2481 ccalcul caracteristiques de la poche froide2482 call calWAKE (paprs,pplay,dtime 2483 : ,t_seri,q_seri,omega2484 : ,dt_dwn,dq_dwn,M_dwn,M_up2485 : ,dt_a,dq_a,sigd2486 : ,wdt_PBL,wdq_PBL2487 : ,udt_PBL,udq_PBL2488 o ,wake_deltat,wake_deltaq,wake_dth2489 o ,wake_h,wake_s,wake_dens2490 o ,wake_pe,wake_fip,wake_gfl2491 o ,dt_wake,dq_wake2492 o ,wake_k, t_undi,q_undi2493 o ,wake_omgbdth,wake_dp_omgb2494 o ,wake_dtKE,wake_dqKE2495 o ,wake_dtPBL,wake_dqPBL2496 o ,wake_omg,wake_dp_deltomg2497 o ,wake_spread,wake_Cstar,wake_d_deltat_gw2498 o,wake_ddeltat,wake_ddeltaq)2499 c 2480 ! 2481 !calcul caracteristiques de la poche froide 2482 call calWAKE (paprs,pplay,dtime & 2483 ,t_seri,q_seri,omega & 2484 ,dt_dwn,dq_dwn,M_dwn,M_up & 2485 ,dt_a,dq_a,sigd & 2486 ,wdt_PBL,wdq_PBL & 2487 ,udt_PBL,udq_PBL & 2488 ,wake_deltat,wake_deltaq,wake_dth & 2489 ,wake_h,wake_s,wake_dens & 2490 ,wake_pe,wake_fip,wake_gfl & 2491 ,dt_wake,dq_wake & 2492 ,wake_k, t_undi,q_undi & 2493 ,wake_omgbdth,wake_dp_omgb & 2494 ,wake_dtKE,wake_dqKE & 2495 ,wake_dtPBL,wake_dqPBL & 2496 ,wake_omg,wake_dp_deltomg & 2497 ,wake_spread,wake_Cstar,wake_d_deltat_gw & 2498 ,wake_ddeltat,wake_ddeltaq) 2499 ! 2500 2500 !----------------------------------------------------------------------------------------- 2501 2501 ! ajout des tendances des poches froides … … 2508 2508 2509 2509 endif 2510 c 2511 c===================================================================2512 cJYG2510 ! 2511 !=================================================================== 2512 !JYG 2513 2513 IF (ip_ebil_phy.ge.2) THEN 2514 2514 ztit='after wake' 2515 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime 2516 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay2517 s, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)2518 call diagphy(airephy,ztit,ip_ebil_phy 2519 e , zero_v, zero_v, zero_v, zero_v, zero_v2520 e , zero_v, zero_v, zero_v, ztsol2521 e , d_h_vcol, d_qt, d_ec2522 s, fs_bound, fq_bound )2515 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime & 2516 , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay & 2517 , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 2518 call diagphy(airephy,ztit,ip_ebil_phy & 2519 , zero_v, zero_v, zero_v, zero_v, zero_v & 2520 , zero_v, zero_v, zero_v, ztsol & 2521 , d_h_vcol, d_qt, d_ec & 2522 , fs_bound, fq_bound ) 2523 2523 END IF 2524 2524 2525 cprint*,'apres callwake iflag_cldcon=', iflag_cldcon2526 c 2527 c===================================================================2528 cConvection seche (thermiques ou ajustement)2529 c===================================================================2530 c 2531 call stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri 2532 s,seuil_inversion,weak_inversion,dthmin)2525 ! print*,'apres callwake iflag_cldcon=', iflag_cldcon 2526 ! 2527 !=================================================================== 2528 ! Convection seche (thermiques ou ajustement) 2529 !=================================================================== 2530 ! 2531 call stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri & 2532 ,seuil_inversion,weak_inversion,dthmin) 2533 2533 2534 2534 … … 2541 2541 d_q_ajs(:,:)=0. 2542 2542 clwcon0th(:,:)=0. 2543 c 2544 cfm_therm(:,:)=0.2545 centr_therm(:,:)=0.2546 cdetr_therm(:,:)=0.2547 c 2548 IF(prt_level>9)WRITE(lunout,*) 2549 . 'AVANT LA CONVECTION SECHE , iflag_thermals='2550 s,iflag_thermals,' nsplit_thermals=',nsplit_thermals2543 ! 2544 ! fm_therm(:,:)=0. 2545 ! entr_therm(:,:)=0. 2546 ! detr_therm(:,:)=0. 2547 ! 2548 IF(prt_level>9)WRITE(lunout,*) & 2549 'AVANT LA CONVECTION SECHE , iflag_thermals=' & 2550 ,iflag_thermals,' nsplit_thermals=',nsplit_thermals 2551 2551 if(iflag_thermals.lt.0) then 2552 cRien2553 c====2552 ! Rien 2553 ! ==== 2554 2554 IF(prt_level>9)WRITE(lunout,*)'pas de convection' 2555 2555 … … 2557 2557 else 2558 2558 2559 cThermiques2560 c==========2561 IF(prt_level>9)WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' 2562 s,iflag_thermals,' nsplit_thermals=',nsplit_thermals2563 2564 2565 ccc nrlmd le 10/04/20122559 ! Thermiques 2560 ! ========== 2561 IF(prt_level>9)WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' & 2562 ,iflag_thermals,' nsplit_thermals=',nsplit_thermals 2563 2564 2565 !cc nrlmd le 10/04/2012 2566 2566 DO k=1,klev+1 2567 2567 DO i=1,klon … … 2572 2572 ENDDO 2573 2573 ENDDO 2574 ccc fin nrlmd le 10/04/20122574 !cc fin nrlmd le 10/04/2012 2575 2575 2576 2576 if (iflag_thermals>=1) then 2577 call calltherm(pdtphys 2578 s ,pplay,paprs,pphi,weak_inversion2579 s ,u_seri,v_seri,t_seri,q_seri,zqsat,debut2580 s ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs2581 s ,fm_therm,entr_therm,detr_therm2582 s ,zqasc,clwcon0th,lmax_th,ratqscth2583 s ,ratqsdiff,zqsatth2584 con rajoute ale et alp, et les caracteristiques de la couche alim2585 s ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca2586 s ,ztv,zpspsk,ztla,zthl2587 ccc nrlmd le 10/04/20122588 e ,pbl_tke_input,pctsrf,omega,airephy2589 s ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max02590 s ,n2,s2,ale_bl_stat2591 s ,therm_tke_max,env_tke_max2592 s ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke2593 s ,alp_bl_conv,alp_bl_stat2594 ccc fin nrlmd le 10/04/20122595 s,zqla,ztva )2596 2597 ccc nrlmd le 10/04/20122598 c-----------Stochastic triggering-----------2577 call calltherm(pdtphys & 2578 ,pplay,paprs,pphi,weak_inversion & 2579 ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & 2580 ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs & 2581 ,fm_therm,entr_therm,detr_therm & 2582 ,zqasc,clwcon0th,lmax_th,ratqscth & 2583 ,ratqsdiff,zqsatth & 2584 !on rajoute ale et alp, et les caracteristiques de la couche alim 2585 ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca & 2586 ,ztv,zpspsk,ztla,zthl & 2587 !cc nrlmd le 10/04/2012 2588 ,pbl_tke_input,pctsrf,omega,airephy & 2589 ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 & 2590 ,n2,s2,ale_bl_stat & 2591 ,therm_tke_max,env_tke_max & 2592 ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke & 2593 ,alp_bl_conv,alp_bl_stat & 2594 !cc fin nrlmd le 10/04/2012 2595 ,zqla,ztva ) 2596 2597 !cc nrlmd le 10/04/2012 2598 !-----------Stochastic triggering----------- 2599 2599 if (iflag_trig_bl.ge.1) then 2600 c 2600 ! 2601 2601 IF (prt_level .GE. 10) THEN 2602 print *,'cin, ale_bl_stat, alp_bl_stat ', 2603 $cin, ale_bl_stat, alp_bl_stat2602 print *,'cin, ale_bl_stat, alp_bl_stat ', & 2603 cin, ale_bl_stat, alp_bl_stat 2604 2604 ENDIF 2605 2605 2606 c----Initialisations2606 !----Initialisations 2607 2607 do i=1,klon 2608 2608 proba_notrig(i)=1. … … 2614 2614 endif 2615 2615 enddo 2616 c 2616 ! 2617 2617 IF (prt_level .GE. 10) THEN 2618 print *,'random_notrig, tau_trig ', 2619 $random_notrig, tau_trig2620 print *,'s_trig,s2,n2 ', 2621 $s_trig,s2,n22618 print *,'random_notrig, tau_trig ', & 2619 random_notrig, tau_trig 2620 print *,'s_trig,s2,n2 ', & 2621 s_trig,s2,n2 2622 2622 ENDIF 2623 2623 2624 c----Tirage al\'eatoire et calcul de ale_bl_trig2624 !----Tirage al\'eatoire et calcul de ale_bl_trig 2625 2625 do i=1,klon 2626 2626 if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) ) then 2627 proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** 2628 $(n2(i)*dtime/tau_trig(i))2629 cprint *, 'proba_notrig(i) ',proba_notrig(i)2627 proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** & 2628 (n2(i)*dtime/tau_trig(i)) 2629 ! print *, 'proba_notrig(i) ',proba_notrig(i) 2630 2630 if (random_notrig(i) .ge. proba_notrig(i)) then 2631 2631 ale_bl_trig(i)=ale_bl_stat(i) … … 2639 2639 endif 2640 2640 enddo 2641 c 2641 ! 2642 2642 IF (prt_level .GE. 10) THEN 2643 print *,'proba_notrig, ale_bl_trig ', 2644 $proba_notrig, ale_bl_trig2643 print *,'proba_notrig, ale_bl_trig ', & 2644 proba_notrig, ale_bl_trig 2645 2645 ENDIF 2646 2646 2647 2647 endif !(iflag_trig_bl) 2648 2648 2649 c-----------Statistical closure-----------2649 !-----------Statistical closure----------- 2650 2650 if (iflag_clos_bl.ge.1) then 2651 2651 … … 2664 2664 ENDIF 2665 2665 2666 ccc fin nrlmd le 10/04/20122666 !cc fin nrlmd le 10/04/2012 2667 2667 2668 2668 ! ---------------------------------------------------------------------- … … 2692 2692 2693 2693 2694 cAjustement sec2695 c==============2694 ! Ajustement sec 2695 ! ============== 2696 2696 2697 2697 ! Dans le cas o\`u on active les thermiques, on fait partir l'ajustement … … 2715 2715 2716 2716 if (iflag_thermals.eq.0) then 2717 CALL ajsec_convV2(paprs, pplay, t_seri,q_seri 2718 s, d_t_ajsb, d_q_ajsb)2717 CALL ajsec_convV2(paprs, pplay, t_seri,q_seri & 2718 , d_t_ajsb, d_q_ajsb) 2719 2719 else 2720 CALL ajsec(paprs, pplay, t_seri,q_seri,limbas 2721 s, d_t_ajsb, d_q_ajsb)2720 CALL ajsec(paprs, pplay, t_seri,q_seri,limbas & 2721 , d_t_ajsb, d_q_ajsb) 2722 2722 endif 2723 2723 … … 2733 2733 2734 2734 endif 2735 c 2736 c===================================================================2737 cIM2735 ! 2736 !=================================================================== 2737 !IM 2738 2738 IF (ip_ebil_phy.ge.2) THEN 2739 2739 ztit='after dry_adjust' 2740 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime 2741 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay2742 s, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)2743 call diagphy(airephy,ztit,ip_ebil_phy 2744 e , zero_v, zero_v, zero_v, zero_v, zero_v2745 e , zero_v, zero_v, zero_v, ztsol2746 e , d_h_vcol, d_qt, d_ec2747 s, fs_bound, fq_bound )2740 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime & 2741 , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay & 2742 , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 2743 call diagphy(airephy,ztit,ip_ebil_phy & 2744 , zero_v, zero_v, zero_v, zero_v, zero_v & 2745 , zero_v, zero_v, zero_v, ztsol & 2746 , d_h_vcol, d_qt, d_ec & 2747 , fs_bound, fq_bound ) 2748 2748 END IF 2749 2749 2750 2750 2751 c-------------------------------------------------------------------------2751 !------------------------------------------------------------------------- 2752 2752 ! Computation of ratqs, the width (normalized) of the subrid scale 2753 2753 ! water distribution 2754 CALL calcratqs(klon,klev,prt_level,lunout, 2755 s iflag_ratqs,iflag_con,iflag_cldcon,pdtphys,2756 s ratqsbas,ratqshaut,tau_ratqs,fact_cldcon,2757 s ptconv,ptconvth,clwcon0th, rnebcon0th,2758 s paprs,pplay,q_seri,zqsat,fm_therm,2759 sratqs,ratqsc)2760 2761 2762 c 2763 cAppeler le processus de condensation a grande echelle2764 cet le processus de precipitation2765 c-------------------------------------------------------------------------2754 CALL calcratqs(klon,klev,prt_level,lunout, & 2755 iflag_ratqs,iflag_con,iflag_cldcon,pdtphys, & 2756 ratqsbas,ratqshaut,tau_ratqs,fact_cldcon, & 2757 ptconv,ptconvth,clwcon0th, rnebcon0th, & 2758 paprs,pplay,q_seri,zqsat,fm_therm, & 2759 ratqs,ratqsc) 2760 2761 2762 ! 2763 ! Appeler le processus de condensation a grande echelle 2764 ! et le processus de precipitation 2765 !------------------------------------------------------------------------- 2766 2766 IF (prt_level .GE.10) THEN 2767 2767 print *,' ->fisrtilp ' 2768 2768 ENDIF 2769 c-------------------------------------------------------------------------2770 CALL fisrtilp(dtime,paprs,pplay, 2771 . t_seri, q_seri,ptconv,ratqs,2772 . d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,2773 . rain_lsc, snow_lsc,2774 . pfrac_impa, pfrac_nucl, pfrac_1nucl,2775 . frac_impa, frac_nucl, beta_prec_fisrt,2776 . prfl, psfl, rhcl,2777 . zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cldcon,2778 .iflag_ice_thermo)2769 !------------------------------------------------------------------------- 2770 CALL fisrtilp(dtime,paprs,pplay, & 2771 t_seri, q_seri,ptconv,ratqs, & 2772 d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, & 2773 rain_lsc, snow_lsc, & 2774 pfrac_impa, pfrac_nucl, pfrac_1nucl, & 2775 frac_impa, frac_nucl, beta_prec_fisrt, & 2776 prfl, psfl, rhcl, & 2777 zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cldcon, & 2778 iflag_ice_thermo) 2779 2779 2780 2780 WHERE (rain_lsc < 0) rain_lsc = 0. … … 2797 2797 DO i = 1, klon 2798 2798 za = za + airephy(i)/REAL(klon) 2799 zx_t = zx_t + (rain_lsc(i) 2800 .+ snow_lsc(i))*airephy(i)/REAL(klon)2799 zx_t = zx_t + (rain_lsc(i) & 2800 + snow_lsc(i))*airephy(i)/REAL(klon) 2801 2801 ENDDO 2802 2802 zx_t = zx_t/za*dtime 2803 2803 WRITE(lunout,*)"Precip=", zx_t 2804 2804 ENDIF 2805 cIM2805 !IM 2806 2806 IF (ip_ebil_phy.ge.2) THEN 2807 2807 ztit='after fisrt' 2808 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime 2809 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay2810 s, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)2811 call diagphy(airephy,ztit,ip_ebil_phy 2812 e , zero_v, zero_v, zero_v, zero_v, zero_v2813 e , zero_v, rain_lsc, snow_lsc, ztsol2814 e , d_h_vcol, d_qt, d_ec2815 s, fs_bound, fq_bound )2808 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime & 2809 , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay & 2810 , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 2811 call diagphy(airephy,ztit,ip_ebil_phy & 2812 , zero_v, zero_v, zero_v, zero_v, zero_v & 2813 , zero_v, rain_lsc, snow_lsc, ztsol & 2814 , d_h_vcol, d_qt, d_ec & 2815 , fs_bound, fq_bound ) 2816 2816 END IF 2817 2817 … … 2823 2823 endif 2824 2824 2825 c 2826 c-------------------------------------------------------------------2827 cPRESCRIPTION DES NUAGES POUR LE RAYONNEMENT2828 c-------------------------------------------------------------------2829 2830 c1. NUAGES CONVECTIFS2831 c 2832 cIM cf FH2833 cIF (iflag_cldcon.eq.-1) THEN ! seulement pour Tiedtke2825 ! 2826 !------------------------------------------------------------------- 2827 ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT 2828 !------------------------------------------------------------------- 2829 2830 ! 1. NUAGES CONVECTIFS 2831 ! 2832 !IM cf FH 2833 ! IF (iflag_cldcon.eq.-1) THEN ! seulement pour Tiedtke 2834 2834 IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke 2835 2835 snow_tiedtke=0. 2836 cprint*,'avant calcul de la pseudo precip '2837 cprint*,'iflag_cldcon',iflag_cldcon2836 ! print*,'avant calcul de la pseudo precip ' 2837 ! print*,'iflag_cldcon',iflag_cldcon 2838 2838 if (iflag_cldcon.eq.-1) then 2839 2839 rain_tiedtke=rain_con 2840 2840 else 2841 cprint*,'calcul de la pseudo precip '2841 ! print*,'calcul de la pseudo precip ' 2842 2842 rain_tiedtke=0. 2843 cprint*,'calcul de la pseudo precip 0'2843 ! print*,'calcul de la pseudo precip 0' 2844 2844 do k=1,klev 2845 2845 do i=1,klon 2846 2846 if (d_q_con(i,k).lt.0.) then 2847 rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys 2848 s*(paprs(i,k)-paprs(i,k+1))/rg2847 rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys & 2848 *(paprs(i,k)-paprs(i,k+1))/rg 2849 2849 endif 2850 2850 enddo 2851 2851 enddo 2852 2852 endif 2853 c 2854 ccall dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')2855 c 2856 2857 cNuages diagnostiques pour Tiedtke2858 CALL diagcld1(paprs,pplay, 2859 cIM cf FH . rain_con,snow_con,ibas_con,itop_con,2860 . rain_tiedtke,snow_tiedtke,ibas_con,itop_con,2861 .diafra,dialiq)2853 ! 2854 ! call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ') 2855 ! 2856 2857 ! Nuages diagnostiques pour Tiedtke 2858 CALL diagcld1(paprs,pplay, & 2859 !IM cf FH . rain_con,snow_con,ibas_con,itop_con, 2860 rain_tiedtke,snow_tiedtke,ibas_con,itop_con, & 2861 diafra,dialiq) 2862 2862 DO k = 1, klev 2863 2863 DO i = 1, klon … … 2870 2870 2871 2871 ELSE IF (iflag_cldcon.ge.3) THEN 2872 cOn prend pour les nuages convectifs le max du calcul de la2873 cconvection et du calcul du pas de temps precedent diminue d'un facteur2874 cfacttemps2872 ! On prend pour les nuages convectifs le max du calcul de la 2873 ! convection et du calcul du pas de temps precedent diminue d'un facteur 2874 ! facttemps 2875 2875 facteur = pdtphys *facttemps 2876 2876 do k=1,klev 2877 2877 do i=1,klon 2878 2878 rnebcon(i,k)=rnebcon(i,k)*facteur 2879 if (rnebcon0(i,k)*clwcon0(i,k).gt.rnebcon(i,k)*clwcon(i,k)) 2880 sthen2879 if (rnebcon0(i,k)*clwcon0(i,k).gt.rnebcon(i,k)*clwcon(i,k)) & 2880 then 2881 2881 rnebcon(i,k)=rnebcon0(i,k) 2882 2882 clwcon(i,k)=clwcon0(i,k) … … 2885 2885 enddo 2886 2886 2887 c 2888 cjq - introduce the aerosol direct and first indirect radiative forcings2889 cjq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)2887 ! 2888 !jq - introduce the aerosol direct and first indirect radiative forcings 2889 !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr) 2890 2890 IF (flag_aerosol .gt. 0) THEN 2891 IF (.NOT. aerosol_couple) 2892 & CALL readaerosol_optic(2893 & debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref,2894 & pdtphys, pplay, paprs, t_seri, rhcl, presnivs,2895 & mass_solu_aero, mass_solu_aero_pi,2896 & tau_aero, piz_aero, cg_aero,2897 &tausum_aero, tau3d_aero)2891 IF (.NOT. aerosol_couple) & 2892 CALL readaerosol_optic( & 2893 debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, & 2894 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 2895 mass_solu_aero, mass_solu_aero_pi, & 2896 tau_aero, piz_aero, cg_aero, & 2897 tausum_aero, tau3d_aero) 2898 2898 ELSE 2899 2899 tausum_aero(:,:,:) = 0. … … 2902 2902 cg_aero(:,:,:,:) = 0. 2903 2903 ENDIF 2904 c 2905 c--STRAT AEROSOL2906 c--updates tausum_aero,tau_aero,piz_aero,cg_aero2904 ! 2905 !--STRAT AEROSOL 2906 !--updates tausum_aero,tau_aero,piz_aero,cg_aero 2907 2907 IF (flag_aerosol_strat) THEN 2908 2908 PRINT *,'appel a readaerosolstrat', mth_cur 2909 2909 CALL readaerosolstrato(debut) 2910 2910 ENDIF 2911 c--fin STRAT AEROSOL2912 2913 cIM calcul nuages par le simulateur ISCCP2914 c 2911 !--fin STRAT AEROSOL 2912 2913 !IM calcul nuages par le simulateur ISCCP 2914 ! 2915 2915 #ifdef histISCCP 2916 2916 IF (ok_isccp) THEN 2917 c 2918 cIM lecture invtau, tautab des fichiers formattes2919 c 2917 ! 2918 !IM lecture invtau, tautab des fichiers formattes 2919 ! 2920 2920 IF (debut) THEN 2921 c$OMP MASTER2922 c 2921 !$OMP MASTER 2922 ! 2923 2923 open(99,file='tautab.formatted', FORM='FORMATTED') 2924 2924 read(99,'(f30.20)') tautab_omp 2925 2925 close(99) 2926 c 2926 ! 2927 2927 open(99,file='invtau.formatted',form='FORMATTED') 2928 2928 read(99,'(i10)') invtau_omp 2929 2929 2930 cprint*,'calcul_simulISCCP invtau_omp',invtau_omp2931 cwrite(6,'(a,8i10)') 'invtau_omp',(invtau_omp(i),i=1,100)2930 ! print*,'calcul_simulISCCP invtau_omp',invtau_omp 2931 ! write(6,'(a,8i10)') 'invtau_omp',(invtau_omp(i),i=1,100) 2932 2932 2933 2933 close(99) 2934 c$OMP END MASTER2935 c$OMP BARRIER2934 !$OMP END MASTER 2935 !$OMP BARRIER 2936 2936 tautab=tautab_omp 2937 2937 invtau=invtau_omp 2938 c 2938 ! 2939 2939 ENDIF !debut 2940 c 2941 cIM appel simulateur toutes les NINT(freq_ISCCP/dtime) heures2940 ! 2941 !IM appel simulateur toutes les NINT(freq_ISCCP/dtime) heures 2942 2942 IF (MOD(itap,NINT(freq_ISCCP/dtime)).EQ.0) THEN 2943 2943 #include "calcul_simulISCCP.h" … … 2946 2946 #endif 2947 2947 2948 cOn prend la somme des fractions nuageuses et des contenus en eau2948 ! On prend la somme des fractions nuageuses et des contenus en eau 2949 2949 2950 2950 if (iflag_cldcon>=5) then … … 3015 3015 ! enddo prfl, psfl, 3016 3016 ! enddo 3017 c 3018 c2. NUAGES STARTIFORMES3019 c 3017 ! 3018 ! 2. NUAGES STARTIFORMES 3019 ! 3020 3020 IF (ok_stratus) THEN 3021 3021 CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq) … … 3029 3029 ENDDO 3030 3030 ENDIF 3031 c 3032 cPrecipitation totale3033 c 3031 ! 3032 ! Precipitation totale 3033 ! 3034 3034 DO i = 1, klon 3035 3035 rain_fall(i) = rain_con(i) + rain_lsc(i) 3036 3036 snow_fall(i) = snow_con(i) + snow_lsc(i) 3037 3037 ENDDO 3038 cIM3038 !IM 3039 3039 IF (ip_ebil_phy.ge.2) THEN 3040 3040 ztit="after diagcld" 3041 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime 3042 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay3043 s, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)3044 call diagphy(airephy,ztit,ip_ebil_phy 3045 e , zero_v, zero_v, zero_v, zero_v, zero_v3046 e , zero_v, zero_v, zero_v, ztsol3047 e , d_h_vcol, d_qt, d_ec3048 s, fs_bound, fq_bound )3041 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime & 3042 , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay & 3043 , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 3044 call diagphy(airephy,ztit,ip_ebil_phy & 3045 , zero_v, zero_v, zero_v, zero_v, zero_v & 3046 , zero_v, zero_v, zero_v, ztsol & 3047 , d_h_vcol, d_qt, d_ec & 3048 , fs_bound, fq_bound ) 3049 3049 END IF 3050 c 3051 cCalculer l'humidite relative pour diagnostique3052 c 3050 ! 3051 ! Calculer l'humidite relative pour diagnostique 3052 ! 3053 3053 DO k = 1, klev 3054 3054 DO i = 1, klon … … 3072 3072 ENDDO 3073 3073 3074 cIM Calcul temp.potentielle a 2m (tpot) et temp. potentielle3075 cequivalente a 2m (tpote) pour diagnostique3076 c 3074 !IM Calcul temp.potentielle a 2m (tpot) et temp. potentielle 3075 ! equivalente a 2m (tpote) pour diagnostique 3076 ! 3077 3077 DO i = 1, klon 3078 3078 tpot(i)=zt2m(i)*(100000./paprs(i,1))**RKAPPA … … 3090 3090 ENDIF 3091 3091 ENDIF 3092 tpote(i) = tpot(i)* 3093 .EXP((Lheat *qsat2m(i))/(RCPD*zt2m(i)))3092 tpote(i) = tpot(i)* & 3093 EXP((Lheat *qsat2m(i))/(RCPD*zt2m(i))) 3094 3094 ENDDO 3095 3095 … … 3102 3102 call chemtime(itap+itau_phy-1, date0, dtime) 3103 3103 IF (config_inca == 'aero') THEN 3104 CALL AEROSOL_METEO_CALC( 3105 $ calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs,3106 $prfl,psfl,pctsrf,airephy,rlat,rlon,u10m,v10m)3104 CALL AEROSOL_METEO_CALC( & 3105 calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, & 3106 prfl,psfl,pctsrf,airephy,rlat,rlon,u10m,v10m) 3107 3107 END IF 3108 3108 3109 3109 zxsnow_dummy(:) = 0.0 3110 3110 3111 CALL chemhook_begin (calday, 3112 $ days_elapsed+1,3113 $ jH_cur,3114 $ pctsrf(1,1),3115 $ rlat,3116 $ rlon,3117 $ airephy,3118 $ paprs,3119 $ pplay,3120 $ coefh(:,:,is_ave),3121 $ pphi,3122 $ t_seri,3123 $ u,3124 $ v,3125 $ wo(:, :, 1),3126 $ q_seri,3127 $ zxtsol,3128 $ zxsnow_dummy,3129 $ solsw,3130 $ albsol1,3131 $ rain_fall,3132 $ snow_fall,3133 $ itop_con,3134 $ ibas_con,3135 $ cldfra,3136 $ iim,3137 $ jjm,3138 $ tr_seri,3139 $ ftsol,3140 $ paprs,3141 $ cdragh,3142 $ cdragm,3143 $ pctsrf,3144 $ pdtphys,3145 $itap)3111 CALL chemhook_begin (calday, & 3112 days_elapsed+1, & 3113 jH_cur, & 3114 pctsrf(1,1), & 3115 rlat, & 3116 rlon, & 3117 airephy, & 3118 paprs, & 3119 pplay, & 3120 coefh(:,:,is_ave), & 3121 pphi, & 3122 t_seri, & 3123 u, & 3124 v, & 3125 wo(:, :, 1), & 3126 q_seri, & 3127 zxtsol, & 3128 zxsnow_dummy, & 3129 solsw, & 3130 albsol1, & 3131 rain_fall, & 3132 snow_fall, & 3133 itop_con, & 3134 ibas_con, & 3135 cldfra, & 3136 iim, & 3137 jjm, & 3138 tr_seri, & 3139 ftsol, & 3140 paprs, & 3141 cdragh, & 3142 cdragm, & 3143 pctsrf, & 3144 pdtphys, & 3145 itap) 3146 3146 3147 3147 CALL VTe(VTinca) … … 3149 3149 #endif 3150 3150 END IF !type_trac = inca 3151 c3152 cCalculer les parametres optiques des nuages et quelques3153 cparametres pour diagnostiques:3154 c 3151 ! 3152 ! Calculer les parametres optiques des nuages et quelques 3153 ! parametres pour diagnostiques: 3154 ! 3155 3155 3156 3156 IF (aerosol_couple) THEN … … 3160 3160 3161 3161 if (ok_newmicro) then 3162 CALL newmicro (ok_cdnc, bl95_b0, bl95_b1, 3163 . paprs, pplay, t_seri, cldliq, cldfra,3164 . cldtau, cldemi, cldh, cldl, cldm, cldt, cldq,3165 e flwp, fiwp, flwc, fiwc,3166 e mass_solu_aero, mass_solu_aero_pi,3167 scldtaupi, re, fl, ref_liq, ref_ice)3162 CALL newmicro (ok_cdnc, bl95_b0, bl95_b1, & 3163 paprs, pplay, t_seri, cldliq, cldfra, & 3164 cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, & 3165 flwp, fiwp, flwc, fiwc, & 3166 mass_solu_aero, mass_solu_aero_pi, & 3167 cldtaupi, re, fl, ref_liq, ref_ice) 3168 3168 else 3169 CALL nuage (paprs, pplay, 3170 . t_seri, cldliq, cldfra, cldtau, cldemi,3171 . cldh, cldl, cldm, cldt, cldq,3172 e ok_aie,3173 e mass_solu_aero, mass_solu_aero_pi,3174 e bl95_b0, bl95_b1,3175 scldtaupi, re, fl)3169 CALL nuage (paprs, pplay, & 3170 t_seri, cldliq, cldfra, cldtau, cldemi, & 3171 cldh, cldl, cldm, cldt, cldq, & 3172 ok_aie, & 3173 mass_solu_aero, mass_solu_aero_pi, & 3174 bl95_b0, bl95_b1, & 3175 cldtaupi, re, fl) 3176 3176 endif 3177 c 3178 cIM betaCRF3179 c 3177 ! 3178 !IM betaCRF 3179 ! 3180 3180 cldtaurad = cldtau 3181 3181 cldtaupirad = cldtaupi 3182 3182 cldemirad = cldemi 3183 3183 3184 c 3185 if(lon1_beta.EQ.-180..AND.lon2_beta.EQ.180..AND. 3186 $lat1_beta.EQ.90..AND.lat2_beta.EQ.-90.) THEN3187 c 3188 cglobal3189 c 3184 ! 3185 if(lon1_beta.EQ.-180..AND.lon2_beta.EQ.180..AND. & 3186 lat1_beta.EQ.90..AND.lat2_beta.EQ.-90.) THEN 3187 ! 3188 ! global 3189 ! 3190 3190 DO k=1, klev 3191 3191 DO i=1, klon … … 3204 3204 ENDDO 3205 3205 ENDDO 3206 c 3206 ! 3207 3207 else 3208 c 3209 cregional3210 c 3208 ! 3209 ! regional 3210 ! 3211 3211 DO k=1, klev 3212 3212 DO i=1,klon 3213 c 3214 if (rlon(i).ge.lon1_beta.AND.rlon(i).le.lon2_beta.AND. 3215 $rlat(i).le.lat1_beta.AND.rlat(i).ge.lat2_beta) THEN3213 ! 3214 if (rlon(i).ge.lon1_beta.AND.rlon(i).le.lon2_beta.AND. & 3215 rlat(i).le.lat1_beta.AND.rlat(i).ge.lat2_beta) THEN 3216 3216 if (pplay(i,k).GE.pfree) THEN 3217 3217 beta(i,k) = beta_pbl … … 3227 3227 cldfrarad(i,k) = cldfra(i,k) * beta(i,k) 3228 3228 endif 3229 c 3229 ! 3230 3230 ENDDO 3231 3231 ENDDO 3232 c 3232 ! 3233 3233 endif 3234 c 3235 cAppeler le rayonnement mais calculer tout d'abord l'albedo du sol.3236 c 3234 ! 3235 ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol. 3236 ! 3237 3237 IF (MOD(itaprad,radpas).EQ.0) THEN 3238 3238 3239 3239 DO i = 1, klon 3240 albsol1(i) = falb1(i,is_oce) * pctsrf(i,is_oce) 3241 . + falb1(i,is_lic) * pctsrf(i,is_lic)3242 . + falb1(i,is_ter) * pctsrf(i,is_ter)3243 .+ falb1(i,is_sic) * pctsrf(i,is_sic)3244 albsol2(i) = falb2(i,is_oce) * pctsrf(i,is_oce) 3245 . + falb2(i,is_lic) * pctsrf(i,is_lic)3246 . + falb2(i,is_ter) * pctsrf(i,is_ter)3247 .+ falb2(i,is_sic) * pctsrf(i,is_sic)3240 albsol1(i) = falb1(i,is_oce) * pctsrf(i,is_oce) & 3241 + falb1(i,is_lic) * pctsrf(i,is_lic) & 3242 + falb1(i,is_ter) * pctsrf(i,is_ter) & 3243 + falb1(i,is_sic) * pctsrf(i,is_sic) 3244 albsol2(i) = falb2(i,is_oce) * pctsrf(i,is_oce) & 3245 + falb2(i,is_lic) * pctsrf(i,is_lic) & 3246 + falb2(i,is_ter) * pctsrf(i,is_ter) & 3247 + falb2(i,is_sic) * pctsrf(i,is_sic) 3248 3248 ENDDO 3249 3249 … … 3257 3257 IF (aerosol_couple) THEN 3258 3258 #ifdef INCA 3259 CALL radlwsw_inca 3260 e (kdlon,kflev,dist, rmu0, fract, solaire,3261 e paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri,3262 e wo(:, :, 1),3263 e cldfrarad, cldemirad, cldtaurad,3264 s heat,heat0,cool,cool0,radsol,albpla,3265 s topsw,toplw,solsw,sollw,3266 s sollwdown,3267 s topsw0,toplw0,solsw0,sollw0,3268 s lwdn0, lwdn, lwup0, lwup,3269 s swdn0, swdn, swup0, swup,3270 e ok_ade, ok_aie,3271 e tau_aero, piz_aero, cg_aero,3272 s topswad_aero, solswad_aero,3273 s topswad0_aero, solswad0_aero,3274 s topsw_aero, topsw0_aero,3275 s solsw_aero, solsw0_aero,3276 e cldtaupirad,3277 stopswai_aero, solswai_aero)3259 CALL radlwsw_inca & 3260 (kdlon,kflev,dist, rmu0, fract, solaire, & 3261 paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, & 3262 wo(:, :, 1), & 3263 cldfrarad, cldemirad, cldtaurad, & 3264 heat,heat0,cool,cool0,radsol,albpla, & 3265 topsw,toplw,solsw,sollw, & 3266 sollwdown, & 3267 topsw0,toplw0,solsw0,sollw0, & 3268 lwdn0, lwdn, lwup0, lwup, & 3269 swdn0, swdn, swup0, swup, & 3270 ok_ade, ok_aie, & 3271 tau_aero, piz_aero, cg_aero, & 3272 topswad_aero, solswad_aero, & 3273 topswad0_aero, solswad0_aero, & 3274 topsw_aero, topsw0_aero, & 3275 solsw_aero, solsw0_aero, & 3276 cldtaupirad, & 3277 topswai_aero, solswai_aero) 3278 3278 3279 3279 #endif 3280 3280 ELSE 3281 c 3282 cIM calcul radiatif pour le cas actuel3283 c 3281 ! 3282 !IM calcul radiatif pour le cas actuel 3283 ! 3284 3284 RCO2 = RCO2_act 3285 3285 RCH4 = RCH4_act … … 3287 3287 RCFC11 = RCFC11_act 3288 3288 RCFC12 = RCFC12_act 3289 c 3289 ! 3290 3290 IF (prt_level .GE.10) THEN 3291 3291 print *,' ->radlwsw, number 1 ' 3292 3292 ENDIF 3293 c 3294 CALL radlwsw 3295 e (dist, rmu0, fract,3296 e paprs, pplay,zxtsol,albsol1, albsol2,3297 e t_seri,q_seri,wo,3298 e cldfrarad, cldemirad, cldtaurad,3299 e ok_ade.OR.flag_aerosol_strat, ok_aie, flag_aerosol,3300 e flag_aerosol_strat,3301 e tau_aero, piz_aero, cg_aero,3302 e cldtaupirad,new_aod,3303 e zqsat, flwc, fiwc,3304 s heat,heat0,cool,cool0,radsol,albpla,3305 s topsw,toplw,solsw,sollw,3306 s sollwdown,3307 s topsw0,toplw0,solsw0,sollw0,3308 s lwdn0, lwdn, lwup0, lwup,3309 s swdn0, swdn, swup0, swup,3310 s topswad_aero, solswad_aero,3311 s topswai_aero, solswai_aero,3312 o topswad0_aero, solswad0_aero,3313 o topsw_aero, topsw0_aero,3314 o solsw_aero, solsw0_aero,3315 otopswcf_aero, solswcf_aero)3293 ! 3294 CALL radlwsw & 3295 (dist, rmu0, fract, & 3296 paprs, pplay,zxtsol,albsol1, albsol2, & 3297 t_seri,q_seri,wo, & 3298 cldfrarad, cldemirad, cldtaurad, & 3299 ok_ade.OR.flag_aerosol_strat, ok_aie, flag_aerosol, & 3300 flag_aerosol_strat, & 3301 tau_aero, piz_aero, cg_aero, & 3302 cldtaupirad,new_aod, & 3303 zqsat, flwc, fiwc, & 3304 heat,heat0,cool,cool0,radsol,albpla, & 3305 topsw,toplw,solsw,sollw, & 3306 sollwdown, & 3307 topsw0,toplw0,solsw0,sollw0, & 3308 lwdn0, lwdn, lwup0, lwup, & 3309 swdn0, swdn, swup0, swup, & 3310 topswad_aero, solswad_aero, & 3311 topswai_aero, solswai_aero, & 3312 topswad0_aero, solswad0_aero, & 3313 topsw_aero, topsw0_aero, & 3314 solsw_aero, solsw0_aero, & 3315 topswcf_aero, solswcf_aero) 3316 3316 3317 c 3318 cIM 2eme calcul radiatif pour le cas perturbe ou au moins un3319 cIM des taux doit etre different du taux actuel3320 cIM Par defaut on a les taux perturbes egaux aux taux actuels3321 c 3317 ! 3318 !IM 2eme calcul radiatif pour le cas perturbe ou au moins un 3319 !IM des taux doit etre different du taux actuel 3320 !IM Par defaut on a les taux perturbes egaux aux taux actuels 3321 ! 3322 3322 if (ok_4xCO2atm) then 3323 if (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. 3324 $RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR.3325 $RCFC12_per.NE.RCFC12_act) THEN3326 c 3323 if (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. & 3324 RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. & 3325 RCFC12_per.NE.RCFC12_act) THEN 3326 ! 3327 3327 RCO2 = RCO2_per 3328 3328 RCH4 = RCH4_per … … 3330 3330 RCFC11 = RCFC11_per 3331 3331 RCFC12 = RCFC12_per 3332 c 3332 ! 3333 3333 IF (prt_level .GE.10) THEN 3334 3334 print *,' ->radlwsw, number 2 ' 3335 3335 ENDIF 3336 c 3337 CALL radlwsw 3338 e (dist, rmu0, fract,3339 e paprs, pplay,zxtsol,albsol1, albsol2,3340 e t_seri,q_seri,wo,3341 e cldfra, cldemi, cldtau,3342 e ok_ade.OR.flag_aerosol_strat, ok_aie, flag_aerosol,3343 e flag_aerosol_strat,3344 e tau_aero, piz_aero, cg_aero,3345 e cldtaupi,new_aod,3346 e zqsat, flwc, fiwc,3347 s heatp,heat0p,coolp,cool0p,radsolp,albplap,3348 s topswp,toplwp,solswp,sollwp,3349 s sollwdownp,3350 s topsw0p,toplw0p,solsw0p,sollw0p,3351 s lwdn0p, lwdnp, lwup0p, lwupp,3352 s swdn0p, swdnp, swup0p, swupp,3353 s topswad_aerop, solswad_aerop,3354 s topswai_aerop, solswai_aerop,3355 o topswad0_aerop, solswad0_aerop,3356 o topsw_aerop, topsw0_aerop,3357 o solsw_aerop, solsw0_aerop,3358 otopswcf_aerop, solswcf_aerop)3336 ! 3337 CALL radlwsw & 3338 (dist, rmu0, fract, & 3339 paprs, pplay,zxtsol,albsol1, albsol2, & 3340 t_seri,q_seri,wo, & 3341 cldfra, cldemi, cldtau, & 3342 ok_ade.OR.flag_aerosol_strat, ok_aie, flag_aerosol, & 3343 flag_aerosol_strat, & 3344 tau_aero, piz_aero, cg_aero, & 3345 cldtaupi,new_aod, & 3346 zqsat, flwc, fiwc, & 3347 heatp,heat0p,coolp,cool0p,radsolp,albplap, & 3348 topswp,toplwp,solswp,sollwp, & 3349 sollwdownp, & 3350 topsw0p,toplw0p,solsw0p,sollw0p, & 3351 lwdn0p, lwdnp, lwup0p, lwupp, & 3352 swdn0p, swdnp, swup0p, swupp, & 3353 topswad_aerop, solswad_aerop, & 3354 topswai_aerop, solswai_aerop, & 3355 topswad0_aerop, solswad0_aerop, & 3356 topsw_aerop, topsw0_aerop, & 3357 solsw_aerop, solsw0_aerop, & 3358 topswcf_aerop, solswcf_aerop) 3359 3359 endif 3360 3360 endif 3361 c 3361 ! 3362 3362 ENDIF ! aerosol_couple 3363 3363 itaprad = 0 … … 3387 3387 END IF 3388 3388 3389 c 3390 cAjouter la tendance des rayonnements (tous les pas)3391 c 3389 ! 3390 ! Ajouter la tendance des rayonnements (tous les pas) 3391 ! 3392 3392 DO k = 1, klev 3393 3393 DO i = 1, klon 3394 t_seri(i,k) = t_seri(i,k) 3395 .+ (heat(i,k)-cool(i,k)) * dtime/RDAY3396 ENDDO 3397 ENDDO 3398 c 3394 t_seri(i,k) = t_seri(i,k) & 3395 + (heat(i,k)-cool(i,k)) * dtime/RDAY 3396 ENDDO 3397 ENDDO 3398 ! 3399 3399 if (mydebug) then 3400 3400 call writefield_phy('u_seri',u_seri,llm) … … 3404 3404 endif 3405 3405 3406 cIM3406 !IM 3407 3407 IF (ip_ebil_phy.ge.2) THEN 3408 3408 ztit='after rad' 3409 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime 3410 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay3411 s, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)3412 call diagphy(airephy,ztit,ip_ebil_phy 3413 e , topsw, toplw, solsw, sollw, zero_v3414 e , zero_v, zero_v, zero_v, ztsol3415 e , d_h_vcol, d_qt, d_ec3416 s, fs_bound, fq_bound )3409 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime & 3410 , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay & 3411 , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 3412 call diagphy(airephy,ztit,ip_ebil_phy & 3413 , topsw, toplw, solsw, sollw, zero_v & 3414 , zero_v, zero_v, zero_v, ztsol & 3415 , d_h_vcol, d_qt, d_ec & 3416 , fs_bound, fq_bound ) 3417 3417 END IF 3418 c 3419 c 3420 cCalculer l'hydrologie de la surface3421 c 3422 cCALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,3423 c. agesno, ftsol,fqsurf,fsnow, ruis)3424 c 3425 3426 c 3427 cCalculer le bilan du sol et la derive de temperature (couplage)3428 c 3418 ! 3419 ! 3420 ! Calculer l'hydrologie de la surface 3421 ! 3422 ! CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap, 3423 ! . agesno, ftsol,fqsurf,fsnow, ruis) 3424 ! 3425 3426 ! 3427 ! Calculer le bilan du sol et la derive de temperature (couplage) 3428 ! 3429 3429 DO i = 1, klon 3430 cbils(i) = radsol(i) - sens(i) - evap(i)*RLVTT3431 ca la demande de JLD3430 ! bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT 3431 ! a la demande de JLD 3432 3432 bils(i) = radsol(i) - sens(i) + zxfluxlat(i) 3433 3433 ENDDO 3434 c 3435 cmoddeblott(jan95)3436 cAppeler le programme de parametrisation de l'orographie3437 ca l'echelle sous-maille:3438 c 3434 ! 3435 !moddeblott(jan95) 3436 ! Appeler le programme de parametrisation de l'orographie 3437 ! a l'echelle sous-maille: 3438 ! 3439 3439 IF (prt_level .GE.10) THEN 3440 3440 print *,' call orography ? ', ok_orodr 3441 3441 ENDIF 3442 c 3442 ! 3443 3443 IF (ok_orodr) THEN 3444 c 3445 cselection des points pour lesquels le shema est actif:3444 ! 3445 ! selection des points pour lesquels le shema est actif: 3446 3446 igwd=0 3447 3447 DO i=1,klon 3448 3448 itest(i)=0 3449 cIF ((zstd(i).gt.10.0)) THEN3449 ! IF ((zstd(i).gt.10.0)) THEN 3450 3450 IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN 3451 3451 itest(i)=1 … … 3454 3454 ENDIF 3455 3455 ENDDO 3456 cigwdim=MAX(1,igwd)3457 c 3456 ! igwdim=MAX(1,igwd) 3457 ! 3458 3458 IF (ok_strato) THEN 3459 3459 3460 CALL drag_noro_strato(klon,klev,dtime,paprs,pplay, 3461 e zmea,zstd, zsig, zgam, zthe,zpic,zval,3462 e igwd,idx,itest,3463 e t_seri, u_seri, v_seri,3464 s zulow, zvlow, zustrdr, zvstrdr,3465 sd_t_oro, d_u_oro, d_v_oro)3460 CALL drag_noro_strato(klon,klev,dtime,paprs,pplay, & 3461 zmea,zstd, zsig, zgam, zthe,zpic,zval, & 3462 igwd,idx,itest, & 3463 t_seri, u_seri, v_seri, & 3464 zulow, zvlow, zustrdr, zvstrdr, & 3465 d_t_oro, d_u_oro, d_v_oro) 3466 3466 3467 3467 ELSE 3468 CALL drag_noro(klon,klev,dtime,paprs,pplay, 3469 e zmea,zstd, zsig, zgam, zthe,zpic,zval,3470 e igwd,idx,itest,3471 e t_seri, u_seri, v_seri,3472 s zulow, zvlow, zustrdr, zvstrdr,3473 sd_t_oro, d_u_oro, d_v_oro)3468 CALL drag_noro(klon,klev,dtime,paprs,pplay, & 3469 zmea,zstd, zsig, zgam, zthe,zpic,zval, & 3470 igwd,idx,itest, & 3471 t_seri, u_seri, v_seri, & 3472 zulow, zvlow, zustrdr, zvstrdr, & 3473 d_t_oro, d_u_oro, d_v_oro) 3474 3474 ENDIF 3475 c 3476 cajout des tendances3475 ! 3476 ! ajout des tendances 3477 3477 !----------------------------------------------------------------------------------------- 3478 3478 ! ajout des tendances de la trainee de l'orographie 3479 3479 CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,'oro') 3480 3480 !----------------------------------------------------------------------------------------- 3481 c 3481 ! 3482 3482 ENDIF ! fin de test sur ok_orodr 3483 c 3483 ! 3484 3484 if (mydebug) then 3485 3485 call writefield_phy('u_seri',u_seri,llm) … … 3490 3490 3491 3491 IF (ok_orolf) THEN 3492 c 3493 cselection des points pour lesquels le shema est actif:3492 ! 3493 ! selection des points pour lesquels le shema est actif: 3494 3494 igwd=0 3495 3495 DO i=1,klon … … 3501 3501 ENDIF 3502 3502 ENDDO 3503 cigwdim=MAX(1,igwd)3504 c 3503 ! igwdim=MAX(1,igwd) 3504 ! 3505 3505 IF (ok_strato) THEN 3506 3506 3507 CALL lift_noro_strato(klon,klev,dtime,paprs,pplay, 3508 e rlat,zmea,zstd,zpic,zgam,zthe,zpic,zval,3509 e igwd,idx,itest,3510 e t_seri, u_seri, v_seri,3511 s zulow, zvlow, zustrli, zvstrli,3512 sd_t_lif, d_u_lif, d_v_lif )3507 CALL lift_noro_strato(klon,klev,dtime,paprs,pplay, & 3508 rlat,zmea,zstd,zpic,zgam,zthe,zpic,zval, & 3509 igwd,idx,itest, & 3510 t_seri, u_seri, v_seri, & 3511 zulow, zvlow, zustrli, zvstrli, & 3512 d_t_lif, d_u_lif, d_v_lif ) 3513 3513 3514 3514 ELSE 3515 CALL lift_noro(klon,klev,dtime,paprs,pplay, 3516 e rlat,zmea,zstd,zpic,3517 e itest,3518 e t_seri, u_seri, v_seri,3519 s zulow, zvlow, zustrli, zvstrli,3520 sd_t_lif, d_u_lif, d_v_lif)3515 CALL lift_noro(klon,klev,dtime,paprs,pplay, & 3516 rlat,zmea,zstd,zpic, & 3517 itest, & 3518 t_seri, u_seri, v_seri, & 3519 zulow, zvlow, zustrli, zvstrli, & 3520 d_t_lif, d_u_lif, d_v_lif) 3521 3521 ENDIF 3522 c3522 ! 3523 3523 !----------------------------------------------------------------------------------------- 3524 3524 ! ajout des tendances de la portance de l'orographie 3525 3525 CALL add_phys_tend(d_u_lif,d_v_lif,d_t_lif,dq0,dql0,'lif') 3526 3526 !----------------------------------------------------------------------------------------- 3527 c 3527 ! 3528 3528 ENDIF ! fin de test sur ok_orolf 3529 CHINES GWD PARAMETRIZATION3529 ! HINES GWD PARAMETRIZATION 3530 3530 3531 3531 IF (ok_hines) then 3532 3532 3533 CALL hines_gwd(klon,klev,dtime,paprs,pplay, 3534 i rlat,t_seri,u_seri,v_seri,3535 o zustrhi,zvstrhi,3536 od_t_hin, d_u_hin, d_v_hin)3537 c 3538 cajout des tendances3533 CALL hines_gwd(klon,klev,dtime,paprs,pplay, & 3534 rlat,t_seri,u_seri,v_seri, & 3535 zustrhi,zvstrhi, & 3536 d_t_hin, d_u_hin, d_v_hin) 3537 ! 3538 ! ajout des tendances 3539 3539 CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,'hin') 3540 3540 3541 3541 ENDIF 3542 c 3543 3544 c 3545 cIM cf. FLott BEG3546 CSTRESS NECESSAIRES: TOUTE LA PHYSIQUE3542 ! 3543 3544 ! 3545 !IM cf. FLott BEG 3546 ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE 3547 3547 3548 3548 if (mydebug) then … … 3559 3559 DO k = 1, klev 3560 3560 DO i = 1, klon 3561 zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime* 3562 c(paprs(i,k)-paprs(i,k+1))/rg3563 zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime* 3564 c(paprs(i,k)-paprs(i,k+1))/rg3565 ENDDO 3566 ENDDO 3567 c 3568 cIM calcul composantes axiales du moment angulaire et couple des montagnes3569 c 3561 zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime* & 3562 (paprs(i,k)-paprs(i,k+1))/rg 3563 zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime* & 3564 (paprs(i,k)-paprs(i,k+1))/rg 3565 ENDDO 3566 ENDDO 3567 ! 3568 !IM calcul composantes axiales du moment angulaire et couple des montagnes 3569 ! 3570 3570 IF (is_sequential .and. ok_orodr) THEN 3571 CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, 3572 C ra,rg,romega,3573 C rlat,rlon,pphis,3574 C zustrdr,zustrli,zustrph,3575 C zvstrdr,zvstrli,zvstrph,3576 C paprs,u,v,3577 Caam, torsfc)3571 CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, & 3572 ra,rg,romega, & 3573 rlat,rlon,pphis, & 3574 zustrdr,zustrli,zustrph, & 3575 zvstrdr,zvstrli,zvstrph, & 3576 paprs,u,v, & 3577 aam, torsfc) 3578 3578 ENDIF 3579 cIM cf. FLott END3580 cIM3579 !IM cf. FLott END 3580 !IM 3581 3581 IF (ip_ebil_phy.ge.2) THEN 3582 3582 ztit='after orography' 3583 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime 3584 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay3585 s, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)3586 call diagphy(airephy,ztit,ip_ebil_phy 3587 e , zero_v, zero_v, zero_v, zero_v, zero_v3588 e , zero_v, zero_v, zero_v, ztsol3589 e , d_h_vcol, d_qt, d_ec3590 s, fs_bound, fq_bound )3583 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime & 3584 , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay & 3585 , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 3586 call diagphy(airephy,ztit,ip_ebil_phy & 3587 , zero_v, zero_v, zero_v, zero_v, zero_v & 3588 , zero_v, zero_v, zero_v, ztsol & 3589 , d_h_vcol, d_qt, d_ec & 3590 , fs_bound, fq_bound ) 3591 3591 END IF 3592 c 3593 c 3592 ! 3593 ! 3594 3594 !==================================================================== 3595 3595 ! Interface Simulateur COSP (Calipso, ISCCP, MISR, ..) … … 3606 3606 ! print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=', 3607 3607 ! s ref_liq,ref_ice 3608 call phys_cosp(itap,dtime,freq_cosp, 3609 $ ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP,3610 $ ecrit_mth,ecrit_day,ecrit_hf,3611 $ klon,klev,rlon,rlat,presnivs,overlap,3612 $ ref_liq,ref_ice,3613 $ pctsrf(:,is_ter)+pctsrf(:,is_lic),3614 $ zu10m,zv10m,pphis,3615 $ zphi,paprs(:,1:klev),pplay,zxtsol,t_seri,3616 $ qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc,3617 $ prfl(:,1:klev),psfl(:,1:klev),3618 $ pmflxr(:,1:klev),pmflxs(:,1:klev),3619 $mr_ozone,cldtau, cldemi)3608 call phys_cosp(itap,dtime,freq_cosp, & 3609 ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, & 3610 ecrit_mth,ecrit_day,ecrit_hf, & 3611 klon,klev,rlon,rlat,presnivs,overlap, & 3612 ref_liq,ref_ice, & 3613 pctsrf(:,is_ter)+pctsrf(:,is_lic), & 3614 zu10m,zv10m,pphis, & 3615 zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, & 3616 qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, & 3617 prfl(:,1:klev),psfl(:,1:klev), & 3618 pmflxr(:,1:klev),pmflxs(:,1:klev), & 3619 mr_ozone,cldtau, cldemi) 3620 3620 3621 3621 ! L calipso2D,calipso3D,cfadlidar,parasolrefl,atb,betamol, … … 3630 3630 ENDIF !ok_cosp 3631 3631 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3632 cAA3633 cAA Installation de l'interface online-offline pour traceurs3634 cAA3635 c====================================================================3636 cCalcul des tendances traceurs3637 c====================================================================3638 C 3632 !AA 3633 !AA Installation de l'interface online-offline pour traceurs 3634 !AA 3635 !==================================================================== 3636 ! Calcul des tendances traceurs 3637 !==================================================================== 3638 ! 3639 3639 3640 3640 IF (type_trac=='repr') THEN … … 3644 3644 END IF 3645 3645 3646 call phytrac ( 3647 I itap, days_elapsed+1, jH_cur, debut,3648 I lafin, dtime, u, v, t,3649 I paprs, pplay, pmfu, pmfd,3650 I pen_u, pde_u, pen_d, pde_d,3651 I cdragh, coefh(:,:,is_ave), fm_therm, entr_therm,3652 I u1, v1, ftsol, pctsrf,3653 I zustar, zu10m, zv10m,3654 I wstar(:,is_ave), ale_bl, ale_wake,3655 I rlat, rlon,3656 I frac_impa,frac_nucl, beta_prec_fisrt,beta_prec,3657 I presnivs, pphis, pphi, albsol1,3658 I sh_in, rhcl, cldfra, rneb,3659 I diafra, cldliq, itop_con, ibas_con,3660 I pmflxr, pmflxs, prfl, psfl,3661 I da, phi, mp, upwd,3662 I phi2, d1a, dam, sij,!<<RomP3663 I wdtrainA, wdtrainM, sigd, clw,elij,!<<RomP3664 I ev, ep, epmlmMm, eplaMm,!<<RomP3665 I dnwd, aerosol_couple, flxmass_w,3666 I tau_aero, piz_aero, cg_aero, ccm,3667 I rfname,3668 I d_tr_dyn,!<<RomP3669 Otr_seri)3646 call phytrac ( & 3647 itap, days_elapsed+1, jH_cur, debut, & 3648 lafin, dtime, u, v, t, & 3649 paprs, pplay, pmfu, pmfd, & 3650 pen_u, pde_u, pen_d, pde_d, & 3651 cdragh, coefh(:,:,is_ave), fm_therm, entr_therm, & 3652 u1, v1, ftsol, pctsrf, & 3653 zustar, zu10m, zv10m, & 3654 wstar(:,is_ave), ale_bl, ale_wake, & 3655 rlat, rlon, & 3656 frac_impa,frac_nucl, beta_prec_fisrt,beta_prec, & 3657 presnivs, pphis, pphi, albsol1, & 3658 sh_in, rhcl, cldfra, rneb, & 3659 diafra, cldliq, itop_con, ibas_con, & 3660 pmflxr, pmflxs, prfl, psfl, & 3661 da, phi, mp, upwd, & 3662 phi2, d1a, dam, sij, & !<<RomP 3663 wdtrainA, wdtrainM, sigd, clw,elij, & !<<RomP 3664 ev, ep, epmlmMm, eplaMm, & !<<RomP 3665 dnwd, aerosol_couple, flxmass_w, & 3666 tau_aero, piz_aero, cg_aero, ccm, & 3667 rfname, & 3668 d_tr_dyn, & !<<RomP 3669 tr_seri) 3670 3670 3671 3671 IF (offline) THEN 3672 3672 3673 IF (prt_level.ge.9) 3674 $print*,'Attention on met a 0 les thermiques pour phystoke'3675 call phystokenc ( 3676 I nlon,klev,pdtphys,rlon,rlat,3677 I t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,3678 I fm_therm,entr_therm,3679 I cdragh,coefh(:,:,is_ave),u1,v1,ftsol,pctsrf,3680 I frac_impa, frac_nucl,3681 I pphis,airephy,dtime,itap,3682 Iqx(:,:,ivap),da,phi,mp,upwd,dnwd)3673 IF (prt_level.ge.9) & 3674 print*,'Attention on met a 0 les thermiques pour phystoke' 3675 call phystokenc ( & 3676 nlon,klev,pdtphys,rlon,rlat, & 3677 t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & 3678 fm_therm,entr_therm, & 3679 cdragh,coefh(:,:,is_ave),u1,v1,ftsol,pctsrf, & 3680 frac_impa, frac_nucl, & 3681 pphis,airephy,dtime,itap, & 3682 qx(:,:,ivap),da,phi,mp,upwd,dnwd) 3683 3683 3684 3684 3685 3685 ENDIF 3686 3686 3687 c 3688 cCalculer le transport de l'eau et de l'energie (diagnostique)3689 c 3690 CALL transp (paprs,zxtsol, 3691 e t_seri, q_seri, u_seri, v_seri, zphi,3692 sve, vq, ue, uq)3693 c 3694 cIM global posePB BEG3687 ! 3688 ! Calculer le transport de l'eau et de l'energie (diagnostique) 3689 ! 3690 CALL transp (paprs,zxtsol, & 3691 t_seri, q_seri, u_seri, v_seri, zphi, & 3692 ve, vq, ue, uq) 3693 ! 3694 !IM global posePB BEG 3695 3695 IF(1.EQ.0) THEN 3696 c 3697 CALL transp_lay (paprs,zxtsol, 3698 e t_seri, q_seri, u_seri, v_seri, zphi,3699 sve_lay, vq_lay, ue_lay, uq_lay)3700 c 3696 ! 3697 CALL transp_lay (paprs,zxtsol, & 3698 t_seri, q_seri, u_seri, v_seri, zphi, & 3699 ve_lay, vq_lay, ue_lay, uq_lay) 3700 ! 3701 3701 ENDIF !(1.EQ.0) THEN 3702 cIM global posePB END3703 cAccumuler les variables a stocker dans les fichiers histoire:3704 c 3702 !IM global posePB END 3703 ! Accumuler les variables a stocker dans les fichiers histoire: 3704 ! 3705 3705 3706 3706 !================================================================ … … 3711 3711 d_t_ec(:,:)=0. 3712 3712 forall (k=1: llm) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA 3713 CALL ener_conserv(klon,klev,pdtphys,u,v,t,qx(:,:,ivap), 3714 s u_seri,v_seri,t_seri,q_seri,pbl_tke(:,:,is_ave)-tke0(:,:),3715 szmasse,exner,d_t_ec)3713 CALL ener_conserv(klon,klev,pdtphys,u,v,t,qx(:,:,ivap), & 3714 u_seri,v_seri,t_seri,q_seri,pbl_tke(:,:,is_ave)-tke0(:,:), & 3715 zmasse,exner,d_t_ec) 3716 3716 t_seri(:,:)=t_seri(:,:)+d_t_ec(:,:) 3717 3717 3718 cIM3718 !IM 3719 3719 IF (ip_ebil_phy.ge.1) THEN 3720 3720 ztit='after physic' 3721 CALL diagetpq(airephy,ztit,ip_ebil_phy,1,1,dtime 3722 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay3723 s, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)3724 CComme les tendances de la physique sont ajoute dans la dynamique,3725 Con devrait avoir que la variation d'entalpie par la dynamique3726 Cest egale a la variation de la physique au pas de temps precedent.3727 CDonc la somme de ces 2 variations devrait etre nulle.3728 3729 call diagphy(airephy,ztit,ip_ebil_phy 3730 e , topsw, toplw, solsw, sollw, sens3731 e , evap, rain_fall, snow_fall, ztsol3732 e , d_h_vcol, d_qt, d_ec3733 s, fs_bound, fq_bound )3734 C 3721 CALL diagetpq(airephy,ztit,ip_ebil_phy,1,1,dtime & 3722 , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay & 3723 , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 3724 ! Comme les tendances de la physique sont ajoute dans la dynamique, 3725 ! on devrait avoir que la variation d'entalpie par la dynamique 3726 ! est egale a la variation de la physique au pas de temps precedent. 3727 ! Donc la somme de ces 2 variations devrait etre nulle. 3728 3729 call diagphy(airephy,ztit,ip_ebil_phy & 3730 , topsw, toplw, solsw, sollw, sens & 3731 , evap, rain_fall, snow_fall, ztsol & 3732 , d_h_vcol, d_qt, d_ec & 3733 , fs_bound, fq_bound ) 3734 ! 3735 3735 d_h_vcol_phy=d_h_vcol 3736 C 3736 ! 3737 3737 END IF 3738 C 3739 c=======================================================================3740 cSORTIES3741 c=======================================================================3742 3743 cIM Interpolation sur les niveaux de pression du NMC3744 c-------------------------------------------------3745 c 3738 ! 3739 !======================================================================= 3740 ! SORTIES 3741 !======================================================================= 3742 3743 !IM Interpolation sur les niveaux de pression du NMC 3744 ! ------------------------------------------------- 3745 ! 3746 3746 #include "calcul_STDlev.h" 3747 c 3748 cslp sea level pressure3747 ! 3748 ! slp sea level pressure 3749 3749 slp(:) = paprs(:,1)*exp(pphis(:)/(RD*t_seri(:,1))) 3750 c 3751 ccc prw = eau precipitable3750 ! 3751 !cc prw = eau precipitable 3752 3752 DO i = 1, klon 3753 3753 prw(i) = 0. 3754 3754 DO k = 1, klev 3755 prw(i) = prw(i) + 3756 .q_seri(i,k)*(paprs(i,k)-paprs(i,k+1))/RG3755 prw(i) = prw(i) + & 3756 q_seri(i,k)*(paprs(i,k)-paprs(i,k+1))/RG 3757 3757 ENDDO 3758 3758 ENDDO 3759 c 3760 cIM initialisation + calculs divers diag AMIP23761 c 3759 ! 3760 !IM initialisation + calculs divers diag AMIP2 3761 ! 3762 3762 #include "calcul_divers.h" 3763 c 3763 ! 3764 3764 IF (type_trac == 'inca') THEN 3765 3765 #ifdef INCA … … 3767 3767 CALL VTb(VTinca) 3768 3768 3769 CALL chemhook_end ( 3770 $ dtime,3771 $ pplay,3772 $ t_seri,3773 $ tr_seri,3774 $ nbtr,3775 $ paprs,3776 $ q_seri,3777 $ airephy,3778 $ pphi,3779 $ pphis,3780 $zx_rh)3769 CALL chemhook_end ( & 3770 dtime, & 3771 pplay, & 3772 t_seri, & 3773 tr_seri, & 3774 nbtr, & 3775 paprs, & 3776 q_seri, & 3777 airephy, & 3778 pphi, & 3779 pphis, & 3780 zx_rh) 3781 3781 3782 3782 CALL VTe(VTinca) … … 3786 3786 3787 3787 3788 c 3789 cConvertir les incrementations en tendances3790 c 3788 ! 3789 ! Convertir les incrementations en tendances 3790 ! 3791 3791 IF (prt_level .GE.10) THEN 3792 3792 print *,'Convertir les incrementations en tendances ' 3793 3793 ENDIF 3794 c 3794 ! 3795 3795 if (mydebug) then 3796 3796 call writefield_phy('u_seri',u_seri,llm) … … 3809 3809 ENDDO 3810 3810 ENDDO 3811 c 3811 ! 3812 3812 IF (nqtot.GE.3) THEN 3813 3813 DO iq = 3, nqtot … … 3819 3819 ENDDO 3820 3820 ENDIF 3821 c 3822 cIM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano3823 cIM global posePB#include "write_bilKP_ins.h"3824 cIM global posePB#include "write_bilKP_ave.h"3825 c 3826 3827 cSauvegarder les valeurs de t et q a la fin de la physique:3828 c 3821 ! 3822 !IM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano 3823 !IM global posePB#include "write_bilKP_ins.h" 3824 !IM global posePB#include "write_bilKP_ave.h" 3825 ! 3826 3827 ! Sauvegarder les valeurs de t et q a la fin de la physique: 3828 ! 3829 3829 DO k = 1, klev 3830 3830 DO i = 1, klon … … 3856 3856 if (prt_level.ge.1) then 3857 3857 write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!' 3858 write(lunout,*) 3859 s'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'3860 write(lunout,*) 3861 s nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys,3862 s pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce),3863 spctsrf(igout,is_sic)3858 write(lunout,*) & 3859 'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos' 3860 write(lunout,*) & 3861 nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, & 3862 pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), & 3863 pctsrf(igout,is_sic) 3864 3864 write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva' 3865 3865 do k=1,klev 3866 write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), 3867 s d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k),3868 sd_t_eva(igout,k)3866 write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), & 3867 d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), & 3868 d_t_eva(igout,k) 3869 3869 enddo 3870 3870 write(lunout,*) 'cool,heat' … … 3875 3875 write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec' 3876 3876 do k=1,klev 3877 write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), 3878 sd_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)3877 write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), & 3878 d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k) 3879 3879 enddo 3880 3880 … … 3882 3882 write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 ' 3883 3883 do k=1,klev 3884 write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), 3885 sd_qx(igout,k,1),d_qx(igout,k,2)3884 write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), & 3885 d_qx(igout,k,1),d_qx(igout,k,2) 3886 3886 enddo 3887 3887 endif … … 3889 3889 !========================================================================== 3890 3890 3891 c============================================================3892 cCalcul de la temperature potentielle3893 c============================================================3891 !============================================================ 3892 ! Calcul de la temperature potentielle 3893 !============================================================ 3894 3894 DO k = 1, klev 3895 3895 DO i = 1, klon 3896 cJYG/IM theta en debut du pas de temps3897 cJYG/IM theta(i,k)=t(i,k)*(100000./pplay(i,k))**(RD/RCPD)3898 cJYG/IM theta en fin de pas de temps de physique3896 !JYG/IM theta en debut du pas de temps 3897 !JYG/IM theta(i,k)=t(i,k)*(100000./pplay(i,k))**(RD/RCPD) 3898 !JYG/IM theta en fin de pas de temps de physique 3899 3899 theta(i,k)=t_seri(i,k)*(100000./pplay(i,k))**(RD/RCPD) 3900 cthetal: 2 lignes suivantes a decommenter si vous avez les fichiers MPL 201306253901 cfth_fonctions.F90 et parkind1.F903902 csinon thetal=theta3903 cthetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),3904 c: ql_seri(i,k))3900 ! thetal: 2 lignes suivantes a decommenter si vous avez les fichiers MPL 20130625 3901 ! fth_fonctions.F90 et parkind1.F90 3902 ! sinon thetal=theta 3903 ! thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k), 3904 ! : ql_seri(i,k)) 3905 3905 thetal(i,k)=theta(i,k) 3906 3906 ENDDO 3907 3907 ENDDO 3908 c 3909 3910 c22.03.04 BEG3911 c=============================================================3912 cEcriture des sorties3913 c=============================================================3908 ! 3909 3910 ! 22.03.04 BEG 3911 !============================================================= 3912 ! Ecriture des sorties 3913 !============================================================= 3914 3914 #ifdef CPP_IOIPSL 3915 3915 3916 cRecupere des varibles calcule dans differents modules3917 cpour ecriture dans histxxx.nc3916 ! Recupere des varibles calcule dans differents modules 3917 ! pour ecriture dans histxxx.nc 3918 3918 3919 3919 ! Get some variables from module fonte_neige_mod 3920 CALL fonte_neige_get_vars(pctsrf, 3921 .zxfqcalving, zxfqfonte, zxffonte)3922 3923 3924 3925 3926 c=============================================================3920 CALL fonte_neige_get_vars(pctsrf, & 3921 zxfqcalving, zxfqfonte, zxffonte) 3922 3923 3924 3925 3926 !============================================================= 3927 3927 ! Separation entre thermiques et non thermiques dans les sorties 3928 3928 ! de fisrtilp 3929 c=============================================================3929 !============================================================= 3930 3930 3931 3931 if (iflag_thermals>=1) then … … 3956 3956 3957 3957 CALL phys_output_write(itap, pdtphys, paprs, pphis, & 3958 &pplay, lmax_th, aerosol_couple, &3959 &ok_ade, ok_aie, ivap, new_aod, ok_sync, &3960 &ptconv, read_climoz, clevSTD, freq_moyNMC, &3961 &ptconvth, d_t, qx, d_qx, zmasse, &3962 &flag_aerosol_strat)3958 pplay, lmax_th, aerosol_couple, & 3959 ok_ade, ok_aie, ivap, new_aod, ok_sync, & 3960 ptconv, read_climoz, clevSTD, freq_moyNMC, & 3961 ptconvth, d_t, qx, d_qx, zmasse, & 3962 flag_aerosol_strat) 3963 3963 3964 3964 … … 3975 3975 #endif 3976 3976 3977 c22.03.04 END3978 c 3979 c====================================================================3980 cSi c'est la fin, il faut conserver l'etat de redemarrage3981 c====================================================================3982 c 3983 3984 c-----------------------------------------------------------------3985 cWSTATS: Saving statistics3986 c-----------------------------------------------------------------3987 c("stats" stores and accumulates 8 key variables in file "stats.nc"3988 cwhich can later be used to make the statistic files of the run:3989 c"stats") only possible in 3D runs !3977 ! 22.03.04 END 3978 ! 3979 !==================================================================== 3980 ! Si c'est la fin, il faut conserver l'etat de redemarrage 3981 !==================================================================== 3982 ! 3983 3984 ! ----------------------------------------------------------------- 3985 ! WSTATS: Saving statistics 3986 ! ----------------------------------------------------------------- 3987 ! ("stats" stores and accumulates 8 key variables in file "stats.nc" 3988 ! which can later be used to make the statistic files of the run: 3989 ! "stats") only possible in 3D runs ! 3990 3990 3991 3991 3992 3992 IF (callstats) THEN 3993 3993 3994 call wstats(klon,o_psol%name,"Surface pressure","Pa" 3995 &,2,paprs(:,1))3996 call wstats(klon,o_tsol%name,"Surface temperature","K", 3997 &2,zxtsol)3994 call wstats(klon,o_psol%name,"Surface pressure","Pa" & 3995 ,2,paprs(:,1)) 3996 call wstats(klon,o_tsol%name,"Surface temperature","K", & 3997 2,zxtsol) 3998 3998 zx_tmp_fi2d(:) = rain_fall(:) + snow_fall(:) 3999 call wstats(klon,o_precip%name,"Precip Totale liq+sol", 4000 &"kg/(s*m2)",2,zx_tmp_fi2d)3999 call wstats(klon,o_precip%name,"Precip Totale liq+sol", & 4000 "kg/(s*m2)",2,zx_tmp_fi2d) 4001 4001 zx_tmp_fi2d(:) = rain_lsc(:) + snow_lsc(:) 4002 call wstats(klon,o_plul%name,"Large-scale Precip", 4003 &"kg/(s*m2)",2,zx_tmp_fi2d)4002 call wstats(klon,o_plul%name,"Large-scale Precip", & 4003 "kg/(s*m2)",2,zx_tmp_fi2d) 4004 4004 zx_tmp_fi2d(:) = rain_con(:) + snow_con(:) 4005 call wstats(klon,o_pluc%name,"Convective Precip", 4006 &"kg/(s*m2)",2,zx_tmp_fi2d)4007 call wstats(klon,o_sols%name,"Solar rad. at surf.", 4008 &"W/m2",2,solsw)4009 call wstats(klon,o_soll%name,"IR rad. at surf.", 4010 &"W/m2",2,sollw)4005 call wstats(klon,o_pluc%name,"Convective Precip", & 4006 "kg/(s*m2)",2,zx_tmp_fi2d) 4007 call wstats(klon,o_sols%name,"Solar rad. at surf.", & 4008 "W/m2",2,solsw) 4009 call wstats(klon,o_soll%name,"IR rad. at surf.", & 4010 "W/m2",2,sollw) 4011 4011 zx_tmp_fi2d(:) = topsw(:)-toplw(:) 4012 call wstats(klon,o_nettop%name,"Net dn radiatif flux at TOA", 4013 &"W/m2",2,zx_tmp_fi2d)4014 4015 4016 4017 call wstats(klon,o_temp%name,"Air temperature","K", 4018 &3,t_seri)4019 call wstats(klon,o_vitu%name,"Zonal wind","m.s-1", 4020 &3,u_seri)4021 call wstats(klon,o_vitv%name,"Meridional wind", 4022 &"m.s-1",3,v_seri)4023 call wstats(klon,o_vitw%name,"Vertical wind", 4024 &"m.s-1",3,omega)4025 call wstats(klon,o_ovap%name,"Specific humidity", "kg/kg", 4026 &3,q_seri)4012 call wstats(klon,o_nettop%name,"Net dn radiatif flux at TOA", & 4013 "W/m2",2,zx_tmp_fi2d) 4014 4015 4016 4017 call wstats(klon,o_temp%name,"Air temperature","K", & 4018 3,t_seri) 4019 call wstats(klon,o_vitu%name,"Zonal wind","m.s-1", & 4020 3,u_seri) 4021 call wstats(klon,o_vitv%name,"Meridional wind", & 4022 "m.s-1",3,v_seri) 4023 call wstats(klon,o_vitw%name,"Vertical wind", & 4024 "m.s-1",3,omega) 4025 call wstats(klon,o_ovap%name,"Specific humidity", "kg/kg", & 4026 3,q_seri) 4027 4027 4028 4028 … … 4041 4041 ! write(97) u_seri,v_seri,t_seri,q_seri 4042 4042 ! close(97) 4043 C$OMP MASTER4043 !$OMP MASTER 4044 4044 if (read_climoz >= 1) then 4045 4045 if (is_mpi_root) then … … 4048 4048 deallocate(press_climoz) ! pointer 4049 4049 end if 4050 C$OMP END MASTER4050 !$OMP END MASTER 4051 4051 ENDIF 4052 4052 … … 4057 4057 FUNCTION qcheck(klon,klev,paprs,q,ql,aire) 4058 4058 IMPLICIT none 4059 c 4060 cCalculer et imprimer l'eau totale. A utiliser pour verifier4061 cla conservation de l'eau4062 c 4059 ! 4060 ! Calculer et imprimer l'eau totale. A utiliser pour verifier 4061 ! la conservation de l'eau 4062 ! 4063 4063 #include "YOMCST.h" 4064 4064 INTEGER klon,klev … … 4067 4067 REAL qtotal, zx, qcheck 4068 4068 INTEGER i, k 4069 c 4069 ! 4070 4070 zx = 0.0 4071 4071 DO i = 1, klon … … 4075 4075 DO k = 1, klev 4076 4076 DO i = 1, klon 4077 qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i) 4078 .*(paprs(i,k)-paprs(i,k+1))/RG4079 ENDDO 4080 ENDDO 4081 c 4077 qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i) & 4078 *(paprs(i,k)-paprs(i,k+1))/RG 4079 ENDDO 4080 ENDDO 4081 ! 4082 4082 qcheck = qtotal/zx 4083 c 4083 ! 4084 4084 RETURN 4085 4085 END 4086 4086 SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit) 4087 4087 IMPLICIT none 4088 c 4089 cTranformer une variable de la grille physique a4090 cla grille d'ecriture4091 c 4088 ! 4089 ! Tranformer une variable de la grille physique a 4090 ! la grille d'ecriture 4091 ! 4092 4092 INTEGER nfield,nlon,iim,jjmp1, jjm 4093 4093 REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield) 4094 c 4094 ! 4095 4095 INTEGER i, n, ig 4096 c 4096 ! 4097 4097 jjm = jjmp1 - 1 4098 4098 DO n = 1, nfield -
LMDZ5/trunk/libf/phylmd/regdim.h
r524 r1862 2 2 ! $Header$ 3 3 ! 4 ! Valid and equivalent for either free source form or fixed source form 4 5 INTEGER i1_deb, i1_fin 5 6 INTEGER i2_deb, i2_fin 6 ccc PARAMETER (i1_deb=21, i1_fin=40)7 ccc PARAMETER (i2_deb=41, i2_fin=44)8 cccc PARAMETER (i1_deb=47, i1_fin=77)9 cccc PARAMETER (i2_deb=78, i2_fin=79)7 !cc PARAMETER (i1_deb=21, i1_fin=40) 8 !cc PARAMETER (i2_deb=41, i2_fin=44) 9 !ccc PARAMETER (i1_deb=47, i1_fin=77) 10 !ccc PARAMETER (i2_deb=78, i2_fin=79) 10 11 PARAMETER (i1_deb=16, i1_fin=30) 11 12 PARAMETER (i2_deb=31, i2_fin=33) 12 c 13 ! 13 14 INTEGER j_deb, j_fin 14 ccc PARAMETER (j_deb=29, j_fin=61)15 cccc PARAMETER (j_deb=21, j_fin=51)15 !cc PARAMETER (j_deb=29, j_fin=61) 16 !ccc PARAMETER (j_deb=21, j_fin=51) 16 17 PARAMETER (j_deb=18, j_fin=39) -
LMDZ5/trunk/libf/phylmd/write_histday_seri.h
r1577 r1862 1 c 2 c$Header$3 c 1 ! 2 ! $Header$ 3 ! 4 4 IF (is_sequential) THEN 5 5 6 6 IF (type_run.EQ."AMIP") THEN 7 c 7 ! 8 8 ndex2d = 0 9 9 itau_w = itau_phy + itap + start_time * day_step / iphysiq 10 c 11 cChamps 2D:12 c 10 ! 11 ! Champs 2D: 12 ! 13 13 pi = ACOS(-1.) 14 14 pir = 4.0*ATAN(1.0) / 180.0 15 c 15 ! 16 16 DO i=1, klon 17 17 zx_tmp_fi2d(i)=(topsw(i)-toplw(i)) 18 18 ENDDO 19 c 19 ! 20 20 ok_msk=.FALSE. 21 21 msk(1:klon)=pctsrf(1:klon,is_ter) 22 CALL moyglo_pondaire(klon, zx_tmp_fi2d, airephy, 23 .ok_msk, msk, moyglo)24 zx_tmp_fi2d(1:klon)=moyglo 25 c 26 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 27 CALL histwrite(nid_day_seri,"bilTOA",itau_w, 28 .zx_tmp_2d,iim*jjmp1,ndex2d)29 c 30 ok_msk=.FALSE. 31 CALL moyglo_pondaire(klon, bils, airephy, 32 .ok_msk, msk, moyglo)33 zx_tmp_fi2d(1:klon)=moyglo 34 c 35 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 36 CALL histwrite(nid_day_seri,"bils",itau_w, 37 .zx_tmp_2d,iim*jjmp1,ndex2d)38 c 22 CALL moyglo_pondaire(klon, zx_tmp_fi2d, airephy, & 23 ok_msk, msk, moyglo) 24 zx_tmp_fi2d(1:klon)=moyglo 25 ! 26 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 27 CALL histwrite(nid_day_seri,"bilTOA",itau_w, & 28 zx_tmp_2d,iim*jjmp1,ndex2d) 29 ! 30 ok_msk=.FALSE. 31 CALL moyglo_pondaire(klon, bils, airephy, & 32 ok_msk, msk, moyglo) 33 zx_tmp_fi2d(1:klon)=moyglo 34 ! 35 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 36 CALL histwrite(nid_day_seri,"bils",itau_w, & 37 zx_tmp_2d,iim*jjmp1,ndex2d) 38 ! 39 39 DO k=1, klev 40 40 DO i=1, klon 41 cIM 080904 zx_tmp_fi3d(i,k)=u(i,k)**2+v(i,k)**241 !IM 080904 zx_tmp_fi3d(i,k)=u(i,k)**2+v(i,k)**2 42 42 zx_tmp_fi3d(i,k)=(u(i,k)**2+v(i,k)**2)/2. 43 43 ENDDO 44 44 ENDDO 45 c 46 CALL moyglo_pondaima(klon, klev, zx_tmp_fi3d, 47 .airephy, paprs, moyglo)48 zx_tmp_fi2d(1:klon)=moyglo 49 c 50 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 51 CALL histwrite(nid_day_seri,"ecin",itau_w, 52 .zx_tmp_2d,iim*jjmp1,ndex2d)53 c 54 cIM 151004 BEG45 ! 46 CALL moyglo_pondaima(klon, klev, zx_tmp_fi3d, & 47 airephy, paprs, moyglo) 48 zx_tmp_fi2d(1:klon)=moyglo 49 ! 50 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 51 CALL histwrite(nid_day_seri,"ecin",itau_w, & 52 zx_tmp_2d,iim*jjmp1,ndex2d) 53 ! 54 !IM 151004 BEG 55 55 IF(1.EQ.0) THEN 56 c 56 ! 57 57 DO k=1, klev 58 58 DO i=1, klon … … 60 60 ENDDO 61 61 ENDDO 62 c 63 CALL moyglo_pondaima(klon, klev, zx_tmp_fi3d, 64 .airephy, paprs, moyglo)65 zx_tmp_fi2d(1:klon)=moyglo 66 c 67 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 68 CALL histwrite(nid_day_seri,"momang",itau_w,zx_tmp_2d, 69 .iim*jjmp1,ndex2d)70 c 71 cfriction torque72 c 62 ! 63 CALL moyglo_pondaima(klon, klev, zx_tmp_fi3d, & 64 airephy, paprs, moyglo) 65 zx_tmp_fi2d(1:klon)=moyglo 66 ! 67 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 68 CALL histwrite(nid_day_seri,"momang",itau_w,zx_tmp_2d, & 69 iim*jjmp1,ndex2d) 70 ! 71 ! friction torque 72 ! 73 73 DO i=1, klon 74 74 zx_tmp_fi2d(i)=zxfluxu(i,1)*RA* cos(pir* rlat(i)) 75 75 ENDDO 76 c 77 ok_msk=.FALSE. 78 CALL moyglo_pondaire(klon, zx_tmp_fi2d, airephy, 79 .ok_msk, msk, moyglo)80 zx_tmp_fi2d(1:klon)=moyglo 81 c 82 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 83 CALL histwrite(nid_day_seri,"frictor",itau_w,zx_tmp_2d, 84 .iim*jjmp1,ndex2d)85 c 86 cmountain torque87 c 88 cIM 190504 BEG76 ! 77 ok_msk=.FALSE. 78 CALL moyglo_pondaire(klon, zx_tmp_fi2d, airephy, & 79 ok_msk, msk, moyglo) 80 zx_tmp_fi2d(1:klon)=moyglo 81 ! 82 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 83 CALL histwrite(nid_day_seri,"frictor",itau_w,zx_tmp_2d, & 84 iim*jjmp1,ndex2d) 85 ! 86 ! mountain torque 87 ! 88 !IM 190504 BEG 89 89 CALL gr_fi_dyn(1,klon,iim+1,jjm+1,airephy,airedyn) 90 90 CALL gr_fi_dyn(klev+1,klon,iim+1,jjm+1,paprs,padyn) … … 97 97 zx_tmp(ij)=0. 98 98 DO k = 1, klev 99 zx_tmp(ij)=zx_tmp(ij)+dudyn(i,j,k)*airedyn(i,j)* 100 $(padyn(i,j,k+1)-padyn(i,j,k))/RG99 zx_tmp(ij)=zx_tmp(ij)+dudyn(i,j,k)*airedyn(i,j)* & 100 (padyn(i,j,k+1)-padyn(i,j,k))/RG 101 101 airetot=airetot+airedyn(i,j) 102 102 ENDDO 103 cIM 190504 mountor=mountor+zx_tmp(ij)*airedyn(i,j)*RA*104 mountor=mountor+zx_tmp(ij)*RA* 105 $cos(pir* rlatdyn(i,j))103 !IM 190504 mountor=mountor+zx_tmp(ij)*airedyn(i,j)*RA* 104 mountor=mountor+zx_tmp(ij)*RA* & 105 cos(pir* rlatdyn(i,j)) 106 106 ENDDO 107 107 ENDDO 108 cIM 151004 BEG108 !IM 151004 BEG 109 109 IF(itap.EQ.1) PRINT*,'airetot=',airetot,airetot/klev 110 cIM 151004 END111 cIM 190504 mountor=mountor/(airetot*airetot)110 !IM 151004 END 111 !IM 190504 mountor=mountor/(airetot*airetot) 112 112 mountor=mountor/airetot 113 c 114 cIM 190504 END113 ! 114 !IM 190504 END 115 115 zx_tmp_2d(1:iim,1:jjmp1)=mountor 116 CALL histwrite(nid_day_seri,"mountor",itau_w,zx_tmp_2d, 117 .iim*jjmp1,ndex2d)118 c 116 CALL histwrite(nid_day_seri,"mountor",itau_w,zx_tmp_2d, & 117 iim*jjmp1,ndex2d) 118 ! 119 119 ENDIF !(1.EQ.0) THEN 120 c 121 c 120 ! 121 ! 122 122 CALL gr_fi_dyn(1,klon,iim+1,jjm+1,airephy,airedyn) 123 123 CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d) 124 124 airetot=0. 125 cDO j = 1, jjmp1126 cDO i = 1, iim+1127 cij=i+(iim+1)*(j-1)128 cDO k = 1, klev129 cairetot=airetot+airedyn(i,j)130 cairetot=airetot+airedyn(i,j)131 cENDDO !k132 cENDDO !i133 cENDDO !j134 c 125 ! DO j = 1, jjmp1 126 ! DO i = 1, iim+1 127 ! ij=i+(iim+1)*(j-1) 128 ! DO k = 1, klev 129 ! airetot=airetot+airedyn(i,j) 130 ! airetot=airetot+airedyn(i,j) 131 ! ENDDO !k 132 ! ENDDO !i 133 ! ENDDO !j 134 ! 135 135 DO i=1, klon 136 136 airetot=airetot+airephy(i) 137 137 ENDDO 138 cIF(itap.EQ.1) PRINT*,'airetotphy=',airetot139 c 138 ! IF(itap.EQ.1) PRINT*,'airetotphy=',airetot 139 ! 140 140 airetot=0. 141 141 DO j=1, jjmp1 … … 144 144 ENDDO 145 145 ENDDO 146 c 147 cIF(itap.EQ.1) PRINT*,'airetotij=',airetot,148 c$ '4piR2',4.*pi*RA*RA149 c 146 ! 147 ! IF(itap.EQ.1) PRINT*,'airetotij=',airetot, 148 ! $ '4piR2',4.*pi*RA*RA 149 ! 150 150 zx_tmp_fi2d(1:klon)=aam/airetot 151 151 CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d) 152 CALL histwrite(nid_day_seri,"momang",itau_w,zx_tmp_2d, 153 .iim*jjmp1,ndex2d)154 c 152 CALL histwrite(nid_day_seri,"momang",itau_w,zx_tmp_2d, & 153 iim*jjmp1,ndex2d) 154 ! 155 155 zx_tmp_fi2d(1:klon)=torsfc/airetot 156 156 CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d) 157 CALL histwrite(nid_day_seri,"torsfc",itau_w,zx_tmp_2d, 158 .iim*jjmp1,ndex2d)159 c 160 cIM 151004 END161 c 162 CALL moyglo_pondmass(klon, klev, t_seri, 163 .airephy, paprs, moyglo)164 zx_tmp_fi2d(1:klon)=moyglo 165 c 157 CALL histwrite(nid_day_seri,"torsfc",itau_w,zx_tmp_2d, & 158 iim*jjmp1,ndex2d) 159 ! 160 !IM 151004 END 161 ! 162 CALL moyglo_pondmass(klon, klev, t_seri, & 163 airephy, paprs, moyglo) 164 zx_tmp_fi2d(1:klon)=moyglo 165 ! 166 166 CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d) 167 CALL histwrite(nid_day_seri,"tamv",itau_w, 168 .zx_tmp_2d,iim*jjmp1,ndex2d)169 c 170 ok_msk=.FALSE. 171 CALL moyglo_pondaire(klon, paprs(:,1), airephy, 172 .ok_msk, msk, moyglo)173 zx_tmp_fi2d(1:klon)=moyglo 174 c 175 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 176 CALL histwrite(nid_day_seri,"psol",itau_w, 177 .zx_tmp_2d,iim*jjmp1,ndex2d)178 c 179 ok_msk=.FALSE. 180 CALL moyglo_pondaire(klon, evap, airephy, 181 .ok_msk, msk, moyglo)182 zx_tmp_fi2d(1:klon)=moyglo 183 c 184 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 185 CALL histwrite(nid_day_seri,"evap",itau_w, 186 .zx_tmp_2d,iim*jjmp1,ndex2d)187 c 188 cDO i=1, klon189 czx_tmp_fi2d(i)=SnowFrac(i,is_ter)190 cENDDO191 c 192 cok_msk=.TRUE.193 cmsk(1:klon)=pctsrf(1:klon,is_ter)194 cCALL moyglo_pondaire(klon, zx_tmp_fi2d, airephy,195 c. ok_msk, msk, moyglo)196 czx_tmp_fi2d(1:klon)=moyglo197 c 198 cCALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)199 cCALL histwrite(nid_day_seri,"SnowFrac",200 c. itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)201 c 202 cDO i=1, klon203 cIM 080904 zx_tmp_fi2d(i)=zsnow_mass(i)/330.*rowl204 czx_tmp_fi2d(i)=zsnow_mass(i)205 cENDDO206 c 207 cIM 140904 ok_msk=.FALSE.208 cok_msk=.TRUE.209 cmsk(1:klon)=pctsrf(1:klon,is_ter)210 cCALL moyglo_pondaire(klon, zx_tmp_fi2d, airephy,211 c. ok_msk, msk, moyglo)212 czx_tmp_fi2d(1:klon)=moyglo213 c 214 cCALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)215 cCALL histwrite(nid_day_seri,"snow_depth",itau_w,216 c. zx_tmp_2d,iim*jjmp1,ndex2d)217 c 167 CALL histwrite(nid_day_seri,"tamv",itau_w, & 168 zx_tmp_2d,iim*jjmp1,ndex2d) 169 ! 170 ok_msk=.FALSE. 171 CALL moyglo_pondaire(klon, paprs(:,1), airephy, & 172 ok_msk, msk, moyglo) 173 zx_tmp_fi2d(1:klon)=moyglo 174 ! 175 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 176 CALL histwrite(nid_day_seri,"psol",itau_w, & 177 zx_tmp_2d,iim*jjmp1,ndex2d) 178 ! 179 ok_msk=.FALSE. 180 CALL moyglo_pondaire(klon, evap, airephy, & 181 ok_msk, msk, moyglo) 182 zx_tmp_fi2d(1:klon)=moyglo 183 ! 184 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d) 185 CALL histwrite(nid_day_seri,"evap",itau_w, & 186 zx_tmp_2d,iim*jjmp1,ndex2d) 187 ! 188 ! DO i=1, klon 189 ! zx_tmp_fi2d(i)=SnowFrac(i,is_ter) 190 ! ENDDO 191 ! 192 ! ok_msk=.TRUE. 193 ! msk(1:klon)=pctsrf(1:klon,is_ter) 194 ! CALL moyglo_pondaire(klon, zx_tmp_fi2d, airephy, 195 ! . ok_msk, msk, moyglo) 196 ! zx_tmp_fi2d(1:klon)=moyglo 197 ! 198 ! CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d) 199 ! CALL histwrite(nid_day_seri,"SnowFrac", 200 ! . itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 201 ! 202 ! DO i=1, klon 203 !IM 080904 zx_tmp_fi2d(i)=zsnow_mass(i)/330.*rowl 204 ! zx_tmp_fi2d(i)=zsnow_mass(i) 205 ! ENDDO 206 ! 207 !IM 140904 ok_msk=.FALSE. 208 ! ok_msk=.TRUE. 209 ! msk(1:klon)=pctsrf(1:klon,is_ter) 210 ! CALL moyglo_pondaire(klon, zx_tmp_fi2d, airephy, 211 ! . ok_msk, msk, moyglo) 212 ! zx_tmp_fi2d(1:klon)=moyglo 213 ! 214 ! CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d) 215 ! CALL histwrite(nid_day_seri,"snow_depth",itau_w, 216 ! . zx_tmp_2d,iim*jjmp1,ndex2d) 217 ! 218 218 DO i=1, klon 219 219 zx_tmp_fi2d(i)=ftsol(i,is_oce) 220 220 ENDDO 221 c 221 ! 222 222 ok_msk=.TRUE. 223 223 msk(1:klon)=pctsrf(1:klon,is_oce) 224 CALL moyglo_pondaire(klon, zx_tmp_fi2d, airephy, 225 .ok_msk, msk, moyglo)226 zx_tmp_fi2d(1:klon)=moyglo 227 c 224 CALL moyglo_pondaire(klon, zx_tmp_fi2d, airephy, & 225 ok_msk, msk, moyglo) 226 zx_tmp_fi2d(1:klon)=moyglo 227 ! 228 228 CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d) 229 CALL histwrite(nid_day_seri,"tsol_"//clnsurf(is_oce), 230 $itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)231 c 232 c=================================================================233 c=================================================================234 c=================================================================235 c 229 CALL histwrite(nid_day_seri,"tsol_"//clnsurf(is_oce), & 230 itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 231 ! 232 !================================================================= 233 !================================================================= 234 !================================================================= 235 ! 236 236 if (ok_sync) then 237 237 call histsync(nid_day_seri) 238 238 endif 239 c 239 ! 240 240 ENDIF !fin test sur type_run.EQ."AMIP" 241 241 -
LMDZ5/trunk/libf/phylmd/write_paramLMDZ_phy.h
r1577 r1862 1 c 2 ccalcul moyennes globales3 c 1 ! 2 ! calcul moyennes globales 3 ! 4 4 zx_tmp_fi2d=bils*airephy 5 5 CALL global_mean(zx_tmp_fi2d,airephy,.TRUE.,gbils) … … 22 22 zx_tmp_fi2d=prw*airephy 23 23 CALL global_mean(zx_tmp_fi2d,airephy,.TRUE.,gprw) 24 c 25 c$OMP MASTER24 ! 25 !$OMP MASTER 26 26 if (is_mpi_root) then 27 c 27 ! 28 28 ndex2d = 0 29 29 itau_w = itau_phy + itap + start_time * day_step / iphysiq 30 c 31 cVariables globales32 c 30 ! 31 ! Variables globales 32 ! 33 33 zx_tmp_0d=R_ecc 34 CALL histwrite(nid_ctesGCM,"R_ecc",itau_w, 35 .zx_tmp_0d,np,ndex2d)36 c 34 CALL histwrite(nid_ctesGCM,"R_ecc",itau_w, & 35 zx_tmp_0d,np,ndex2d) 36 ! 37 37 zx_tmp_0d=R_peri 38 CALL histwrite(nid_ctesGCM,"R_peri",itau_w, 39 .zx_tmp_0d,np,ndex2d)40 c 38 CALL histwrite(nid_ctesGCM,"R_peri",itau_w, & 39 zx_tmp_0d,np,ndex2d) 40 ! 41 41 zx_tmp_0d=R_incl 42 CALL histwrite(nid_ctesGCM,"R_incl",itau_w, 43 .zx_tmp_0d,np,ndex2d)44 c 42 CALL histwrite(nid_ctesGCM,"R_incl",itau_w, & 43 zx_tmp_0d,np,ndex2d) 44 ! 45 45 zx_tmp_0d=solaire 46 CALL histwrite(nid_ctesGCM,"solaire",itau_w, 47 .zx_tmp_0d,np,ndex2d)48 c 46 CALL histwrite(nid_ctesGCM,"solaire",itau_w, & 47 zx_tmp_0d,np,ndex2d) 48 ! 49 49 zx_tmp_0d=co2_ppm 50 CALL histwrite(nid_ctesGCM,"co2_ppm",itau_w, 51 .zx_tmp_0d,np,ndex2d)52 c 50 CALL histwrite(nid_ctesGCM,"co2_ppm",itau_w, & 51 zx_tmp_0d,np,ndex2d) 52 ! 53 53 zx_tmp_0d=CH4_ppb 54 CALL histwrite(nid_ctesGCM,"CH4_ppb",itau_w, 55 .zx_tmp_0d,np,ndex2d)56 c 54 CALL histwrite(nid_ctesGCM,"CH4_ppb",itau_w, & 55 zx_tmp_0d,np,ndex2d) 56 ! 57 57 zx_tmp_0d=N2O_ppb 58 CALL histwrite(nid_ctesGCM,"N2O_ppb",itau_w, 59 .zx_tmp_0d,np,ndex2d)60 c 58 CALL histwrite(nid_ctesGCM,"N2O_ppb",itau_w, & 59 zx_tmp_0d,np,ndex2d) 60 ! 61 61 zx_tmp_0d=CFC11_ppt 62 CALL histwrite(nid_ctesGCM,"CFC11_ppt",itau_w, 63 .zx_tmp_0d,np,ndex2d)64 c 62 CALL histwrite(nid_ctesGCM,"CFC11_ppt",itau_w, & 63 zx_tmp_0d,np,ndex2d) 64 ! 65 65 zx_tmp_0d=CFC12_ppt 66 CALL histwrite(nid_ctesGCM,"CFC12_ppt",itau_w, 67 .zx_tmp_0d,np,ndex2d)68 c 69 c=================================================================70 cmoyennes globales71 c 72 CALL histwrite(nid_ctesGCM,"bils",itau_w, 73 .gbils,np,ndex2d)74 CALL histwrite(nid_ctesGCM,"evap",itau_w, 75 .gevap,np,ndex2d)76 CALL histwrite(nid_ctesGCM,"evap_land",itau_w, 77 .gevapt,np,ndex2d)78 CALL histwrite(nid_ctesGCM,"flat",itau_w, 79 .glat,np,ndex2d)80 CALL histwrite(nid_ctesGCM,"nettop0",itau_w, 81 .gnet0,np,ndex2d)82 CALL histwrite(nid_ctesGCM,"nettop",itau_w, 83 .gnet,np,ndex2d)84 CALL histwrite(nid_ctesGCM,"precip",itau_w, 85 .grain,np,ndex2d)86 CALL histwrite(nid_ctesGCM,"tsol",itau_w, 87 .gtsol,np,ndex2d)88 CALL histwrite(nid_ctesGCM,"t2m",itau_w, 89 .gt2m,np,ndex2d)90 CALL histwrite(nid_ctesGCM,"prw",itau_w, 91 .gprw,np,ndex2d)92 c=================================================================93 c 66 CALL histwrite(nid_ctesGCM,"CFC12_ppt",itau_w, & 67 zx_tmp_0d,np,ndex2d) 68 ! 69 !================================================================= 70 ! moyennes globales 71 ! 72 CALL histwrite(nid_ctesGCM,"bils",itau_w, & 73 gbils,np,ndex2d) 74 CALL histwrite(nid_ctesGCM,"evap",itau_w, & 75 gevap,np,ndex2d) 76 CALL histwrite(nid_ctesGCM,"evap_land",itau_w, & 77 gevapt,np,ndex2d) 78 CALL histwrite(nid_ctesGCM,"flat",itau_w, & 79 glat,np,ndex2d) 80 CALL histwrite(nid_ctesGCM,"nettop0",itau_w, & 81 gnet0,np,ndex2d) 82 CALL histwrite(nid_ctesGCM,"nettop",itau_w, & 83 gnet,np,ndex2d) 84 CALL histwrite(nid_ctesGCM,"precip",itau_w, & 85 grain,np,ndex2d) 86 CALL histwrite(nid_ctesGCM,"tsol",itau_w, & 87 gtsol,np,ndex2d) 88 CALL histwrite(nid_ctesGCM,"t2m",itau_w, & 89 gt2m,np,ndex2d) 90 CALL histwrite(nid_ctesGCM,"prw",itau_w, & 91 gprw,np,ndex2d) 92 !================================================================= 93 ! 94 94 if (ok_sync) then 95 95 call histsync(nid_ctesGCM) 96 96 endif 97 c 97 ! 98 98 endif !(is_mpi_root) then 99 c$OMP END MASTER99 !$OMP END MASTER
Note: See TracChangeset
for help on using the changeset viewer.
