Changeset 1447
- Timestamp:
- Oct 22, 2010, 6:18:27 PM (14 years ago)
- Location:
- LMDZ5/branches/LMDZ5V1.0-dev/libf
- Files:
-
- 6 edited
- 2 moved
-
dyn3d/ener.h (modified) (1 diff)
-
dyn3dpar/ener.h (modified) (1 diff)
-
phylmd/initphysto.F90 (moved) (moved from LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmd/initphysto.F) (1 diff)
-
phylmd/phyetat0.F (modified) (1 diff)
-
phylmd/physiq.F (modified) (1 diff)
-
phylmd/phystokenc.F90 (moved) (moved from LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmd/phystokenc.F) (1 diff)
-
phylmd/phytrac.F90 (modified) (3 diffs)
-
phylmd/traclmdz_mod.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/LMDZ5V1.0-dev/libf/dyn3d/ener.h
r524 r1447 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 c----------------------------------------------------------------------- 5 c INCLUDE 'ener.h' 4 ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre 5 ! veillez à n'utiliser que des ! pour les commentaires 6 ! et à bien positionner les & des lignes de continuation 7 ! (les placer en colonne 6 et en colonne 73) 8 ! 9 ! INCLUDE 'ener.h' 6 10 7 COMMON/ener/ang0,etot0,ptot0,ztot0,stot0, 8 * ang,etot,ptot,ztot,stot,rmsdpdt ,9 *rmsv,gtot(llmm1)11 COMMON/ener/ang0,etot0,ptot0,ztot0,stot0, & 12 & ang,etot,ptot,ztot,stot,rmsdpdt , & 13 & rmsv,gtot(llmm1) 10 14 11 REAL ang0,etot0,ptot0,ztot0,stot0, 12 sang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot15 REAL ang0,etot0,ptot0,ztot0,stot0, & 16 & ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot 13 17 14 c-----------------------------------------------------------------------18 !----------------------------------------------------------------------- -
LMDZ5/branches/LMDZ5V1.0-dev/libf/dyn3dpar/ener.h
r774 r1447 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 c----------------------------------------------------------------------- 5 c INCLUDE 'ener.h' 4 ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre 5 ! veillez à n'utiliser que des ! pour les commentaires 6 ! et à bien positionner les & des lignes de continuation 7 ! (les placer en colonne 6 et en colonne 73) 8 ! 9 ! INCLUDE 'ener.h' 6 10 7 COMMON/ener/ang0,etot0,ptot0,ztot0,stot0, 8 * ang,etot,ptot,ztot,stot,rmsdpdt ,9 *rmsv,gtot(llmm1)11 COMMON/ener/ang0,etot0,ptot0,ztot0,stot0, & 12 & ang,etot,ptot,ztot,stot,rmsdpdt , & 13 & rmsv,gtot(llmm1) 10 14 11 REAL ang0,etot0,ptot0,ztot0,stot0, 12 sang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot15 REAL ang0,etot0,ptot0,ztot0,stot0, & 16 & ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot 13 17 14 c-----------------------------------------------------------------------18 !----------------------------------------------------------------------- -
LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmd/initphysto.F90
r1436 r1447 2 2 ! $Id$ 3 3 ! 4 C 5 C 6 subroutine initphysto 7 . (infile, 8 . rlon, rlat, tstep,t_ops,t_wrt,nq,fileid) 9 10 USE dimphy 11 USE mod_phys_lmdz_para 12 USE IOIPSL 13 USE iophy 14 USE control_mod 15 16 implicit none 17 18 C 19 C Routine d'initialisation des ecritures des fichiers histoires LMDZ 20 C au format IOIPSL 21 C 22 C Appels succesifs des routines: histbeg 23 C histhori 24 C histver 25 C histdef 26 C histend 27 C 28 C Entree: 29 C 30 C infile: nom du fichier histoire a creer 31 C day0,anne0: date de reference 32 C tstep: duree du pas de temps en seconde 33 C t_ops: frequence de l'operation pour IOIPSL 34 C t_wrt: frequence d'ecriture sur le fichier 35 C nq: nombre de traceurs 36 C 37 C Sortie: 38 C fileid: ID du fichier netcdf cree 39 C filevid:ID du fichier netcdf pour la grille v 40 C 41 C L. Fairhead, LMD, 03/99 42 C 43 C ===================================================================== 44 C 45 C Declarations 46 #include "dimensions.h" 47 #include "paramet.h" 48 #include "comconst.h" 49 #include "comgeom.h" 50 #include "temps.h" 51 #include "ener.h" 52 #include "logic.h" 53 #include "description.h" 54 #include "serre.h" 55 #include "indicesol.h" 56 cym#include "dimphy.h" 57 58 C Arguments 59 character*(*) infile 60 integer nhoriid, i 61 real tstep, t_ops, t_wrt 62 integer fileid, filevid 63 integer nq,l 64 real nivsigs(llm) 65 66 C Variables locales 67 C 68 integer tau0 69 real zjulian 70 character*3 str 71 character*10 ctrac 72 integer iq 73 integer uhoriid, vhoriid, thoriid, zvertiid 74 integer ii,jj 75 integer zan, idayref 76 logical ok_sync 77 REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1) 78 C 79 REAL rlon(klon), rlat(klon) 80 81 C Initialisations 82 C 83 pi = 4. * atan (1.) 84 str='q ' 85 ctrac = 'traceur ' 86 ok_sync= .true. 87 C 88 C Appel a histbeg: creation du fichier netcdf et initialisations diverses 89 C 90 91 zan = annee_ref 92 idayref = day_ref 93 CALL ymds2ju(zan, 1, idayref, 0.0, zjulian) 94 tau0 = 0 4 SUBROUTINE initphysto(infile,tstep,t_ops,t_wrt,fileid) 5 6 USE dimphy 7 USE mod_phys_lmdz_para 8 USE IOIPSL 9 USE iophy 10 USE control_mod 11 12 IMPLICIT NONE 13 14 ! 15 ! Routine d'initialisation des ecritures des fichiers histoires LMDZ 16 ! au format IOIPSL 17 ! 18 ! Appels succesifs des routines: histbeg 19 ! histhori 20 ! histver 21 ! histdef 22 ! histend 23 ! 24 ! Entree: 25 ! 26 ! infile: nom du fichier histoire a creer 27 ! day0,anne0: date de reference 28 ! tstep: duree du pas de temps en seconde 29 ! t_ops: frequence de l'operation pour IOIPSL 30 ! t_wrt: frequence d'ecriture sur le fichier 31 ! 32 ! Sortie: 33 ! fileid: ID du fichier netcdf cree 34 ! 35 ! L. Fairhead, LMD, 03/99 36 ! 37 ! ===================================================================== 38 ! 39 ! Declarations 40 INCLUDE "dimensions.h" 41 INCLUDE "paramet.h" 42 INCLUDE "comconst.h" 43 INCLUDE "comgeom.h" 44 INCLUDE "temps.h" 45 INCLUDE "logic.h" 46 INCLUDE "description.h" 47 INCLUDE "serre.h" 48 INCLUDE "indicesol.h" 49 50 ! Arguments 51 CHARACTER(len=*), INTENT(IN) :: infile 52 REAL, INTENT(IN) :: tstep 53 REAL, INTENT(IN) :: t_ops 54 REAL, INTENT(IN) :: t_wrt 55 INTEGER, INTENT(OUT) :: fileid 56 57 ! Variables locales 58 INTEGER nhoriid, i 59 INTEGER l,k 60 REAL nivsigs(llm) 61 INTEGER tau0 62 REAL zjulian 63 INTEGER iq 64 INTEGER uhoriid, vhoriid, thoriid, zvertiid 65 INTEGER ii,jj 66 INTEGER zan, idayref 67 LOGICAL ok_sync 68 REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1) 69 CHARACTER(len=12) :: nvar 70 71 ! Initialisations 72 ! 73 pi = 4. * ATAN (1.) 74 ok_sync= .TRUE. 75 ! 76 ! Appel a histbeg: creation du fichier netcdf et initialisations diverses 77 ! 78 79 zan = annee_ref 80 idayref = day_ref 81 CALL ymds2ju(zan, 1, idayref, 0.0, zjulian) 82 tau0 = 0 83 84 CALL histbeg_phy(infile,tau0, zjulian, tstep, & 85 nhoriid, fileid) 86 87 !$OMP MASTER 88 ! Appel a histvert pour la grille verticale 89 ! 90 DO l=1,llm 91 nivsigs(l)=REAL(l) 92 ENDDO 93 94 CALL histvert(fileid, 'sig_s', 'Niveaux sigma', & 95 'sigma_level', & 96 llm, nivsigs, zvertiid) 97 ! 98 ! Appels a histdef pour la definition des variables a sauvegarder 99 ! 100 CALL histdef(fileid, "phis", "Surface geop. height", "-", & 101 iim,jj_nb,nhoriid, 1,1,1, -99, 32, & 102 "once", t_ops, t_wrt) 103 104 CALL histdef(fileid, "aire", "Grid area", "-", & 105 iim,jj_nb,nhoriid, 1,1,1, -99, 32, & 106 "once", t_ops, t_wrt) 107 108 CALL histdef(fileid, "longitudes", "longitudes", "-", & 109 iim,jj_nb,nhoriid, 1,1,1, -99, 32, & 110 "once", t_ops, t_wrt) 111 112 CALL histdef(fileid, "latitudes", "latitudes", "-", & 113 iim,jj_nb,nhoriid, 1,1,1, -99, 32, & 114 "once", t_ops, t_wrt) 115 ! T 116 CALL histdef(fileid, 't', 'Temperature', 'K', iim, jj_nb, nhoriid, & 117 llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt) 118 ! mfu 119 CALL histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s',iim, jj_nb, nhoriid, & 120 llm, 1, llm, zvertiid,32, 'inst(X)', t_ops, t_wrt) 121 ! mfd 122 CALL histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s',iim, jj_nb, nhoriid, & 123 llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt) 124 ! en_u 125 CALL histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s', iim, jj_nb, nhoriid, & 126 llm, 1, llm, zvertiid,32, 'inst(X)', t_ops, t_wrt) 127 ! de_u 128 CALL histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s',iim, jj_nb, nhoriid, & 129 llm, 1, llm, zvertiid,32, 'inst(X)', t_ops, t_wrt) 130 ! en_d 131 CALL histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s', iim, jj_nb, nhoriid, & 132 llm, 1, llm, zvertiid,32, 'inst(X)', t_ops, t_wrt) 133 ! de_d 134 CALL histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s', iim, jj_nb, nhoriid, & 135 llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt) 136 ! coefh 137 CALL histdef(fileid, "coefh", " ", " ", iim, jj_nb, nhoriid, & 138 llm, 1, llm, zvertiid,32, "inst(X)", t_ops, t_wrt) 139 ! fm_th 140 CALL histdef(fileid, "fm_th", " ", " ",iim, jj_nb, nhoriid, & 141 llm, 1, llm, zvertiid,32, "inst(X)", t_ops, t_wrt) 142 ! en_th 143 CALL histdef(fileid, "en_th", " ", " ",iim, jj_nb, nhoriid, & 144 llm, 1, llm, zvertiid,32, "inst(X)", t_ops, t_wrt) 145 ! frac_impa 146 CALL histdef(fileid, 'frac_impa', ' ', ' ',iim, jj_nb, nhoriid, & 147 llm, 1, llm, zvertiid,32, 'inst(X)', t_ops, t_wrt) 148 ! frac_nucl 149 CALL histdef(fileid, 'frac_nucl', ' ', ' ',iim, jj_nb, nhoriid, & 150 llm, 1, llm, zvertiid,32, 'inst(X)', t_ops, t_wrt) 151 ! pyu1 152 CALL histdef(fileid, "pyu1", " ", " ", iim,jj_nb,nhoriid, & 153 1,1,1, -99, 32, "inst(X)", t_ops, t_wrt) 154 ! pyv1 155 CALL histdef(fileid, "pyv1", " ", " ", iim,jj_nb,nhoriid, & 156 1,1,1, -99, 32,"inst(X)", t_ops, t_wrt) 157 ! ftsol1 158 CALL histdef(fileid, "ftsol1", " ", " ",iim, jj_nb, nhoriid, & 159 1, 1,1, -99,32, "inst(X)", t_ops, t_wrt) 160 ! ftsol2 161 CALL histdef(fileid, "ftsol2", " ", " ",iim, jj_nb, nhoriid, & 162 1, 1,1, -99,32, "inst(X)", t_ops, t_wrt) 163 ! ftsol3 164 CALL histdef(fileid, "ftsol3", " ", " ", iim, jj_nb, nhoriid, & 165 1, 1,1, -99,32, "inst(X)", t_ops, t_wrt) 166 ! ftsol4 167 CALL histdef(fileid, "ftsol4", " ", " ",iim, jj_nb, nhoriid, & 168 1, 1,1, -99, 32, "inst(X)", t_ops, t_wrt) 169 ! psrf1 170 CALL histdef(fileid, "psrf1", " ", " ",iim, jj_nb, nhoriid, & 171 1, 1, 1, -99,32, "inst(X)", t_ops, t_wrt) 172 ! psrf2 173 CALL histdef(fileid, "psrf2", " ", " ",iim, jj_nb, nhoriid, & 174 1, 1, 1, -99, 32, "inst(X)", t_ops, t_wrt) 175 ! psrf3 176 CALL histdef(fileid, "psrf3", " ", " ",iim, jj_nb, nhoriid, & 177 1, 1, 1, -99, 32, "inst(X)", t_ops, t_wrt) 178 ! psrf4 179 CALL histdef(fileid, "psrf4", " ", " ", iim, jj_nb, nhoriid, & 180 1, 1, 1, -99,32, "inst(X)", t_ops, t_wrt) 181 ! sh 182 CALL histdef(fileid, 'sh', '', '', iim, jj_nb, nhoriid, & 183 llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt) 184 ! da 185 CALL histdef(fileid, 'da', '', '', iim, jj_nb, nhoriid, & 186 llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt) 187 ! mp 188 CALL histdef(fileid, 'mp', '', '', iim, jj_nb, nhoriid, & 189 llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt) 190 ! upwd 191 CALL histdef(fileid, 'upwd', '', '', iim, jj_nb, nhoriid, & 192 llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt) 193 ! dnwd 194 CALL histdef(fileid, 'dnwd', '', '', iim, jj_nb, nhoriid, & 195 llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt) 196 197 ! phi 198 DO k=1,llm 199 IF (k<10) THEN 200 WRITE(nvar,'(i1)') k 201 ELSE IF (k<100) THEN 202 WRITE(nvar,'(i2)') k 203 ELSE 204 WRITE(nvar,'(i3)') k 205 END IF 206 nvar='phi_lev'//trim(nvar) 207 208 CALL histdef(fileid, nvar, '', '', iim, jj_nb, nhoriid, & 209 llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt) 210 END DO 211 212 CALL histend(fileid) 213 IF (ok_sync) CALL histsync 214 !$OMP END MASTER 95 215 96 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon) 97 cym DO i = 1, iim 98 cym zx_lon(i,1) = rlon(i+1) 99 cym zx_lon(i,jjm+1) = rlon(i+1) 100 cym ENDDO 101 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat) 102 103 104 call histbeg_phy(infile,tau0, zjulian, tstep, 105 . nhoriid, fileid) 106 107 c$OMP MASTER 108 C Appel a histvert pour la grille verticale 109 C 110 DO l=1,llm 111 nivsigs(l)=REAL(l) 112 ENDDO 113 114 write(*,*) 'avant histvert ds initphysto' 115 116 call histvert(fileid, 'sig_s', 'Niveaux sigma', 117 . 'sigma_level', 118 . llm, nivsigs, zvertiid) 119 C 120 C Appels a histdef pour la definition des variables a sauvegarder 121 C 122 write(*,*) 'apres histvert ds initphysto' 123 124 CALL histdef(fileid, "phis", "Surface geop. height", "-", 125 . iim,jj_nb,nhoriid, 1,1,1, -99, 32, 126 . "once", t_ops, t_wrt) 127 c 128 write(*,*) 'apres phis ds initphysto' 129 130 CALL histdef(fileid, "aire", "Grid area", "-", 131 . iim,jj_nb,nhoriid, 1,1,1, -99, 32, 132 . "once", t_ops, t_wrt) 133 write(*,*) 'apres aire ds initphysto' 134 135 cym Attention dtime et istphy ne sont pas �rit ---> a �iminer ? 136 CALL histdef(fileid, "dtime", "tps phys ", "s", 137 . 1,1,nhoriid, 1,1,1, -99, 32, 138 . "once", t_ops, t_wrt) 139 140 CALL histdef(fileid, "istphy", "tps stock", "s", 141 . 1,1,nhoriid, 1,1,1, -99, 32, 142 . "once", t_ops, t_wrt) 143 144 C T 145 C 146 call histdef(fileid, 't', 'Temperature', 'K', 147 . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, 148 . 32, 'inst(X)', t_ops, t_wrt) 149 write(*,*) 'apres t ds initphysto' 150 C mfu 151 C 152 call histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s', 153 . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, 154 . 32, 'inst(X)', t_ops, t_wrt) 155 write(*,*) 'apres mfu ds initphysto' 156 C 157 C mfd 158 C 159 call histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s', 160 . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, 161 . 32, 'inst(X)', t_ops, t_wrt) 162 163 C 164 C en_u 165 C 166 call histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s', 167 . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, 168 . 32, 'inst(X)', t_ops, t_wrt) 169 write(*,*) 'apres en_u ds initphysto' 170 C 171 C de_u 172 C 173 call histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s', 174 . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, 175 . 32, 'inst(X)', t_ops, t_wrt) 176 177 C 178 C en_d 179 C 180 call histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s', 181 . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, 182 . 32, 'inst(X)', t_ops, t_wrt) 183 C 184 185 C 186 C de_d 187 C 188 call histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s', 189 . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, 190 . 32, 'inst(X)', t_ops, t_wrt) 191 192 c coefh frac_impa,frac_nucl 193 194 call histdef(fileid, "coefh", " ", " ", 195 . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, 196 . 32, "inst(X)", t_ops, t_wrt) 197 198 c abderrahmane le 16 09 02 199 call histdef(fileid, "fm_th", " ", " ", 200 . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, 201 . 32, "inst(X)", t_ops, t_wrt) 202 203 call histdef(fileid, "en_th", " ", " ", 204 . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, 205 . 32, "inst(X)", t_ops, t_wrt) 206 c fin aj 207 208 write(*,*) 'apres coefh ds initphysto' 209 210 call histdef(fileid, 'frac_impa', ' ', ' ', 211 . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, 212 . 32, 'inst(X)', t_ops, t_wrt) 213 214 call histdef(fileid, 'frac_nucl', ' ', ' ', 215 . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, 216 . 32, 'inst(X)', t_ops, t_wrt) 217 218 c 219 c pyu1 220 c 221 CALL histdef(fileid, "pyu1", " ", " ", 222 . iim,jj_nb,nhoriid, 1,1,1, -99, 32, 223 . "inst(X)", t_ops, t_wrt) 224 225 c 226 c pyv1 227 c 228 CALL histdef(fileid, "pyv1", " ", " ", 229 . iim,jj_nb,nhoriid, 1,1,1, -99, 32, 230 . "inst(X)", t_ops, t_wrt) 231 232 write(*,*) 'apres pyv1 ds initphysto' 233 c 234 c ftsol1 235 c 236 call histdef(fileid, "ftsol1", " ", " ", 237 . iim, jj_nb, nhoriid, 1, 1,1, -99,32, 238 . "inst(X)", t_ops, t_wrt) 239 240 c 241 c ftsol2 242 c 243 call histdef(fileid, "ftsol2", " ", " ", 244 . iim, jj_nb, nhoriid, 1, 1,1, -99,32, 245 . "inst(X)", t_ops, t_wrt) 246 247 c 248 c ftsol3 249 c 250 call histdef(fileid, "ftsol3", " ", " ", 251 . iim, jj_nb, nhoriid, 1, 1,1, -99, 252 . 32, "inst(X)", t_ops, t_wrt) 253 254 c 255 c ftsol4 256 c 257 call histdef(fileid, "ftsol4", " ", " ", 258 . iim, jj_nb, nhoriid, 1, 1,1, -99, 259 . 32, "inst(X)", t_ops, t_wrt) 260 261 c 262 c rain 263 c 264 call histdef(fileid, "rain", " ", " ", 265 . iim, jj_nb, nhoriid, 1, 1,1, -99, 266 . 32, "inst(X)", t_ops, t_wrt) 267 268 c 269 c psrf1 270 c 271 call histdef(fileid, "psrf1", " ", " ", 272 . iim, jj_nb, nhoriid, 1, 1, 1, -99, 273 . 32, "inst(X)", t_ops, t_wrt) 274 275 c 276 c psrf2 277 c 278 call histdef(fileid, "psrf2", " ", " ", 279 . iim, jj_nb, nhoriid, 1, 1, 1, -99, 280 . 32, "inst(X)", t_ops, t_wrt) 281 282 c 283 c psrf3 284 c 285 call histdef(fileid, "psrf3", " ", " ", 286 . iim, jj_nb, nhoriid, 1, 1, 1, -99, 287 . 32, "inst(X)", t_ops, t_wrt) 288 289 c 290 c psrf4 291 c 292 call histdef(fileid, "psrf4", " ", " ", 293 . iim, jj_nb, nhoriid, 1, 1, 1, -99, 294 . 32, "inst(X)", t_ops, t_wrt) 295 296 write(*,*) 'avant histend ds initphysto' 297 298 call histend(fileid) 299 c if (ok_sync) call histsync(fileid) 300 if (ok_sync) call histsync 301 c$OMP END MASTER 302 303 304 return 305 end 216 END SUBROUTINE initphysto -
LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmd/phyetat0.F
r1444 r1447 134 134 135 135 136 137 IF( clesphy0(1).NE.tab_cntrl( 5 ) ) THEN 138 clesphy0(1)=tab_cntrl( 5 ) 139 ENDIF 140 141 IF( clesphy0(2).NE.tab_cntrl( 6 ) ) THEN 142 clesphy0(2)=tab_cntrl( 6 ) 143 ENDIF 144 145 IF( clesphy0(3).NE.tab_cntrl( 7 ) ) THEN 146 clesphy0(3)=tab_cntrl( 7 ) 147 ENDIF 148 149 IF( clesphy0(4).NE.tab_cntrl( 8 ) ) THEN 150 clesphy0(4)=tab_cntrl( 8 ) 151 ENDIF 152 153 IF( clesphy0(5).NE.tab_cntrl( 9 ) ) THEN 154 clesphy0(5)=tab_cntrl( 9 ) 155 ENDIF 156 157 IF( clesphy0(6).NE.tab_cntrl( 10 ) ) THEN 158 clesphy0(6)=tab_cntrl( 10 ) 159 ENDIF 160 161 IF( clesphy0(7).NE.tab_cntrl( 11 ) ) THEN 162 clesphy0(7)=tab_cntrl( 11 ) 163 ENDIF 164 165 IF( clesphy0(8).NE.tab_cntrl( 12 ) ) THEN 166 clesphy0(8)=tab_cntrl( 12 ) 167 ENDIF 168 136 clesphy0(1)=tab_cntrl( 5 ) 137 clesphy0(2)=tab_cntrl( 6 ) 138 clesphy0(3)=tab_cntrl( 7 ) 139 clesphy0(4)=tab_cntrl( 8 ) 140 clesphy0(5)=tab_cntrl( 9 ) 141 clesphy0(6)=tab_cntrl( 10 ) 142 clesphy0(7)=tab_cntrl( 11 ) 143 clesphy0(8)=tab_cntrl( 12 ) 169 144 170 145 c -
LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmd/physiq.F
r1428 r1447 3376 3376 I cdragh,coefh,u1,v1,ftsol,pctsrf, 3377 3377 I frac_impa, frac_nucl, 3378 I pphis,airephy,dtime,itap) 3378 I pphis,airephy,dtime,itap, 3379 I rlon,rlat,qx(:,:,ivap),da,phi,mp,upwd,dnwd) 3379 3380 3380 3381 -
LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmd/phystokenc.F90
r1436 r1447 1 ! 2 c 3 c 4 SUBROUTINE phystokenc ( 5 I nlon,nlev,pdtphys,rlon,rlat, 6 I pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, 7 I pfm_therm,pentr_therm, 8 I cdragh, pcoefh,yu1,yv1,ftsol,pctsrf, 9 I frac_impa,frac_nucl, 10 I pphis,paire,dtime,itap) 11 USE ioipsl 12 USE dimphy 13 USE infotrac, ONLY : nqtot 14 USE iophy 15 USE control_mod 16 17 IMPLICIT none 18 19 c====================================================================== 20 c Auteur(s) FH 21 c Objet: Moniteur general des tendances traceurs 22 c 23 24 c====================================================================== 25 #include "dimensions.h" 26 #include "tracstoke.h" 27 #include "indicesol.h" 28 c====================================================================== 29 30 c Arguments: 31 c 32 c EN ENTREE: 33 c ========== 34 c 35 c divers: 36 c ------- 37 c 38 integer nlon ! nombre de points horizontaux 39 integer nlev ! nombre de couches verticales 40 real pdtphys ! pas d'integration pour la physique (seconde) 41 c 42 integer physid, itap 43 save physid 44 c$OMP THREADPRIVATE(physid) 45 integer ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev) 46 47 c convection: 48 c ----------- 49 c 50 REAL pmfu(klon,klev) ! flux de masse dans le panache montant 51 REAL pmfd(klon,klev) ! flux de masse dans le panache descendant 52 REAL pen_u(klon,klev) ! flux entraine dans le panache montant 53 REAL pde_u(klon,klev) ! flux detraine dans le panache montant 54 REAL pen_d(klon,klev) ! flux entraine dans le panache descendant 55 REAL pde_d(klon,klev) ! flux detraine dans le panache descendant 56 real pt(klon,klev) 57 REAL,allocatable,save :: t(:,:) 58 c$OMP THREADPRIVATE(t) 59 c 60 REAL rlon(klon), rlat(klon), dtime 61 REAL zx_tmp_3d(iim,jjm+1,klev),zx_tmp_2d(iim,jjm+1) 62 63 c Couche limite: 64 c -------------- 65 c 66 REAL cdragh(klon) ! cdrag 67 REAL pcoefh(klon,klev) ! coeff melange CL 68 REAL pcoefh_buf(klon,klev) ! coeff melange CL + cdrag 69 REAL yv1(klon) 70 REAL yu1(klon),pphis(klon),paire(klon) 71 72 c Les Thermiques : (Abderr 25 11 02) 73 c --------------- 74 REAL pfm_therm(klon,klev+1) 75 real fm_therm1(klon,klev) 76 REAL pentr_therm(klon,klev) 77 78 REAL,allocatable,save :: entr_therm(:,:) 79 REAL,allocatable,save :: fm_therm(:,:) 80 c$OMP THREADPRIVATE(entr_therm) 81 c$OMP THREADPRIVATE(fm_therm) 82 c 83 c Lessivage: 84 c ---------- 85 c 86 REAL frac_impa(klon,klev) 87 REAL frac_nucl(klon,klev) 88 c 89 c Arguments necessaires pour les sources et puits de traceur 90 C 91 real ftsol(klon,nbsrf) ! Temperature du sol (surf)(Kelvin) 92 real pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol) 93 c====================================================================== 94 c 95 INTEGER i, k 96 c 97 REAL,allocatable,save :: mfu(:,:) ! flux de masse dans le panache montant 98 REAL,allocatable,save :: mfd(:,:) ! flux de masse dans le panache descendant 99 REAL,allocatable,save :: en_u(:,:) ! flux entraine dans le panache montant 100 REAL,allocatable,save :: de_u(:,:) ! flux detraine dans le panache montant 101 REAL,allocatable,save :: en_d(:,:) ! flux entraine dans le panache descendant 102 REAL,allocatable,save :: de_d(:,:) ! flux detraine dans le panache descendant 103 REAL,allocatable,save :: coefh(:,:) ! flux detraine dans le panache descendant 104 105 REAL,allocatable,save :: pyu1(:) 106 REAL,allocatable,save :: pyv1(:) 107 REAL,allocatable,save :: pftsol(:,:) 108 REAL,allocatable,save :: ppsrf(:,:) 109 c$OMP THREADPRIVATE(mfu,mfd,en_u,de_u,en_d,de_d,coefh) 110 c$OMP THREADPRIVATE(pyu1,pyv1,pftsol,ppsrf) 111 real pftsol1(klon),pftsol2(klon),pftsol3(klon),pftsol4(klon) 112 real ppsrf1(klon),ppsrf2(klon),ppsrf3(klon),ppsrf4(klon) 113 114 REAL dtcum 115 116 integer iadvtr,irec 117 real zmin,zmax 118 logical ok_sync 119 120 save dtcum 121 save iadvtr,irec 122 c$OMP THREADPRIVATE(dtcum,iadvtr,irec) 123 data iadvtr,irec/0,1/ 124 logical,save :: first=.true. 125 c$OMP THREADPRIVATE(first) 126 c 127 c Couche limite: 128 c====================================================================== 129 130 c Dans le meme vecteur on recombine le drag et les coeff d'echange 131 pcoefh_buf(:,1) = cdragh(:) 132 pcoefh_buf(:,2:klev) = pcoefh(:,2:klev) 133 134 ok_sync = .true. 135 print*,'Dans phystokenc.F' 136 print*,'iadvtr= ',iadvtr 137 print*,'istphy= ',istphy 138 print*,'istdyn= ',istdyn 139 140 if (first) then 141 142 allocate( t(klon,klev)) 143 allocate( mfu(klon,klev)) 144 allocate( mfd(klon,klev)) 145 allocate( en_u(klon,klev)) 146 allocate( de_u(klon,klev)) 147 allocate( en_d(klon,klev)) 148 allocate( de_d(klon,klev)) 149 allocate( coefh(klon,klev)) 150 allocate( entr_therm(klon,klev)) 151 allocate( fm_therm(klon,klev)) 152 allocate( pyu1(klon)) 153 allocate( pyv1(klon)) 154 allocate( pftsol(klon,nbsrf)) 155 allocate( ppsrf(klon,nbsrf)) 156 157 first=.false. 158 endif 159 160 IF (iadvtr.eq.0) THEN 161 162 CALL initphysto('phystoke', 163 . rlon,rlat,dtime, dtime*istphy,dtime*istphy,nqtot,physid) 164 165 write(*,*) 'apres initphysto ds phystokenc' 166 167 168 ENDIF 169 c 170 ndex2d = 0 171 ndex3d = 0 172 i=itap 173 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d) 174 CALL histwrite_phy(physid,"phis",i,pphis) 175 c 176 i=itap 177 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d) 178 CALL histwrite_phy(physid,"aire",i,paire) 179 180 iadvtr=iadvtr+1 181 c 182 if (mod(iadvtr,istphy).eq.1.or.istphy.eq.1) then 183 print*,'reinitialisation des champs cumules 184 s a iadvtr=',iadvtr 185 do k=1,klev 186 do i=1,klon 187 mfu(i,k)=0. 188 mfd(i,k)=0. 189 en_u(i,k)=0. 190 de_u(i,k)=0. 191 en_d(i,k)=0. 192 de_d(i,k)=0. 193 coefh(i,k)=0. 194 t(i,k)=0. 195 fm_therm(i,k)=0. 196 entr_therm(i,k)=0. 197 enddo 198 enddo 199 do i=1,klon 200 pyv1(i)=0. 201 pyu1(i)=0. 202 end do 203 do k=1,nbsrf 204 do i=1,klon 205 pftsol(i,k)=0. 206 ppsrf(i,k)=0. 207 enddo 208 enddo 209 210 dtcum=0. 211 endif 212 213 do k=1,klev 214 do i=1,klon 215 mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys 216 mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys 217 en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys 218 de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys 219 en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys 220 de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys 221 coefh(i,k)=coefh(i,k)+pcoefh_buf(i,k)*pdtphys 222 t(i,k)=t(i,k)+pt(i,k)*pdtphys 223 fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys 224 entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys 225 enddo 226 enddo 227 do i=1,klon 228 pyv1(i)=pyv1(i)+yv1(i)*pdtphys 229 pyu1(i)=pyu1(i)+yu1(i)*pdtphys 230 end do 231 do k=1,nbsrf 232 do i=1,klon 233 pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys 234 ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys 235 enddo 236 enddo 237 238 dtcum=dtcum+pdtphys 239 240 IF(mod(iadvtr,istphy).eq.0) THEN 241 c 242 c normalisation par le temps cumule 243 do k=1,klev 244 do i=1,klon 245 mfu(i,k)=mfu(i,k)/dtcum 246 mfd(i,k)=mfd(i,k)/dtcum 247 en_u(i,k)=en_u(i,k)/dtcum 248 de_u(i,k)=de_u(i,k)/dtcum 249 en_d(i,k)=en_d(i,k)/dtcum 250 de_d(i,k)=de_d(i,k)/dtcum 251 coefh(i,k)=coefh(i,k)/dtcum 252 c Unitel a enlever 253 t(i,k)=t(i,k)/dtcum 254 fm_therm(i,k)=fm_therm(i,k)/dtcum 255 entr_therm(i,k)=entr_therm(i,k)/dtcum 256 enddo 257 enddo 258 do i=1,klon 259 pyv1(i)=pyv1(i)/dtcum 260 pyu1(i)=pyu1(i)/dtcum 261 end do 262 do k=1,nbsrf 263 do i=1,klon 264 pftsol(i,k)=pftsol(i,k)/dtcum 265 pftsol1(i) = pftsol(i,1) 266 pftsol2(i) = pftsol(i,2) 267 pftsol3(i) = pftsol(i,3) 268 pftsol4(i) = pftsol(i,4) 269 270 ppsrf(i,k)=ppsrf(i,k)/dtcum 271 ppsrf1(i) = ppsrf(i,1) 272 ppsrf2(i) = ppsrf(i,2) 273 ppsrf3(i) = ppsrf(i,3) 274 ppsrf4(i) = ppsrf(i,4) 275 276 enddo 277 enddo 278 c 279 c ecriture des champs 280 c 281 irec=irec+1 282 283 ccccc 284 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d) 285 CALL histwrite_phy(physid,"t",itap,t) 286 287 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d) 288 CALL histwrite_phy(physid,"mfu",itap,mfu) 289 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d) 290 CALL histwrite_phy(physid,"mfd",itap,mfd) 291 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d) 292 CALL histwrite_phy(physid,"en_u",itap,en_u) 293 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d) 294 CALL histwrite_phy(physid,"de_u",itap,de_u) 295 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d) 296 CALL histwrite_phy(physid,"en_d",itap,en_d) 297 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d) 298 CALL histwrite_phy(physid,"de_d",itap,de_d) 299 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d) 300 CALL histwrite_phy(physid,"coefh",itap,coefh) 301 302 c ajou... 303 do k=1,klev 304 do i=1,klon 305 fm_therm1(i,k)=fm_therm(i,k) 306 enddo 307 enddo 308 309 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, fm_therm1, zx_tmp_3d) 310 CALL histwrite_phy(physid,"fm_th",itap,fm_therm1) 311 c 312 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1, entr_therm, zx_tmp_3d) 313 CALL histwrite_phy(physid,"en_th",itap,entr_therm) 314 cccc 315 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d) 316 CALL histwrite_phy(physid,"frac_impa",itap,frac_impa) 317 318 cym CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d) 319 CALL histwrite_phy(physid,"frac_nucl",itap,frac_nucl) 320 321 cym CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d) 322 CALL histwrite_phy(physid,"pyu1",itap,pyu1) 323 324 cym CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d) 325 CALL histwrite_phy(physid,"pyv1",itap,pyv1) 326 327 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d) 328 CALL histwrite_phy(physid,"ftsol1",itap,pftsol1) 329 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d) 330 CALL histwrite_phy(physid,"ftsol2",itap,pftsol2) 331 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d) 332 CALL histwrite_phy(physid,"ftsol3",itap,pftsol3) 333 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d) 334 CALL histwrite_phy(physid,"ftsol4",itap,pftsol4) 335 336 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d) 337 CALL histwrite_phy(physid,"psrf1",itap,ppsrf1) 338 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d) 339 CALL histwrite_phy(physid,"psrf2",itap,ppsrf2) 340 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d) 341 CALL histwrite_phy(physid,"psrf3",itap,ppsrf3) 342 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d) 343 CALL histwrite_phy(physid,"psrf4",itap,ppsrf4) 344 345 c$OMP MASTER 346 if (ok_sync) call histsync(physid) 347 c$OMP END MASTER 348 c if (ok_sync) call histsync 349 350 c 351 cAA Test sur la valeur des coefficients de lessivage 352 c 353 zmin=1e33 354 zmax=-1e33 355 do k=1,klev 356 do i=1,klon 357 zmax=max(zmax,frac_nucl(i,k)) 358 zmin=min(zmin,frac_nucl(i,k)) 359 enddo 360 enddo 361 Print*,'------ coefs de lessivage (min et max) --------' 362 Print*,'facteur de nucleation ',zmin,zmax 363 zmin=1e33 364 zmax=-1e33 365 do k=1,klev 366 do i=1,klon 367 zmax=max(zmax,frac_impa(i,k)) 368 zmin=min(zmin,frac_impa(i,k)) 369 enddo 370 enddo 371 Print*,'facteur d impaction ',zmin,zmax 372 373 ENDIF 374 375 c reinitialisation des champs cumules 376 go to 768 377 if (mod(iadvtr,istphy).eq.1) then 378 do k=1,klev 379 do i=1,klon 380 mfu(i,k)=0. 381 mfd(i,k)=0. 382 en_u(i,k)=0. 383 de_u(i,k)=0. 384 en_d(i,k)=0. 385 de_d(i,k)=0. 386 coefh(i,k)=0. 387 t(i,k)=0. 388 fm_therm(i,k)=0. 389 entr_therm(i,k)=0. 390 enddo 391 enddo 392 do i=1,klon 393 pyv1(i)=0. 394 pyu1(i)=0. 395 end do 396 do k=1,nbsrf 397 do i=1,klon 398 pftsol(i,k)=0. 399 ppsrf(i,k)=0. 400 enddo 401 enddo 402 403 dtcum=0. 404 endif 405 406 do k=1,klev 407 do i=1,klon 408 mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys 409 mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys 410 en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys 411 de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys 412 en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys 413 de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys 414 coefh(i,k)=coefh(i,k)+pcoefh_buf(i,k)*pdtphys 415 t(i,k)=t(i,k)+pt(i,k)*pdtphys 416 fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys 417 entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys 418 enddo 419 enddo 420 do i=1,klon 421 pyv1(i)=pyv1(i)+yv1(i)*pdtphys 422 pyu1(i)=pyu1(i)+yu1(i)*pdtphys 423 end do 424 do k=1,nbsrf 425 do i=1,klon 426 pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys 427 ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys 428 enddo 429 enddo 430 431 dtcum=dtcum+pdtphys 432 768 continue 433 434 RETURN 435 END 1 SUBROUTINE phystokenc (nlon,nlev,pdtphys,rlon,rlat, & 2 pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & 3 pfm_therm,pentr_therm, & 4 cdragh, pcoefh,yu1,yv1,ftsol,pctsrf, & 5 frac_impa,frac_nucl, & 6 pphis,paire,dtime,itap, & 7 psh, pda, pphi, pmp, pupwd, pdnwd) 8 9 USE ioipsl 10 USE dimphy 11 USE infotrac, ONLY : nqtot 12 USE iophy 13 USE control_mod 14 15 IMPLICIT NONE 16 17 !====================================================================== 18 ! Auteur(s) FH 19 ! Objet: Ecriture des variables pour transport offline 20 ! 21 !====================================================================== 22 INCLUDE "dimensions.h" 23 INCLUDE "tracstoke.h" 24 INCLUDE "indicesol.h" 25 INCLUDE "iniprint.h" 26 !====================================================================== 27 28 ! Arguments: 29 ! 30 REAL,DIMENSION(klon,klev), INTENT(IN) :: psh ! humidite specifique 31 REAL,DIMENSION(klon,klev), INTENT(IN) :: pda 32 REAL,DIMENSION(klon,klev,klev), INTENT(IN):: pphi 33 REAL,DIMENSION(klon,klev), INTENT(IN) :: pmp 34 REAL,DIMENSION(klon,klev), INTENT(IN) :: pupwd ! saturated updraft mass flux 35 REAL,DIMENSION(klon,klev), INTENT(IN) :: pdnwd ! saturated downdraft mass flux 36 37 ! EN ENTREE: 38 ! ========== 39 ! 40 ! divers: 41 ! ------- 42 ! 43 INTEGER nlon ! nombre de points horizontaux 44 INTEGER nlev ! nombre de couches verticales 45 REAL pdtphys ! pas d'integration pour la physique (seconde) 46 INTEGER itap 47 INTEGER, SAVE :: physid 48 !$OMP THREADPRIVATE(physid) 49 50 ! convection: 51 ! ----------- 52 ! 53 REAL pmfu(klon,klev) ! flux de masse dans le panache montant 54 REAL pmfd(klon,klev) ! flux de masse dans le panache descendant 55 REAL pen_u(klon,klev) ! flux entraine dans le panache montant 56 REAL pde_u(klon,klev) ! flux detraine dans le panache montant 57 REAL pen_d(klon,klev) ! flux entraine dans le panache descendant 58 REAL pde_d(klon,klev) ! flux detraine dans le panache descendant 59 REAL pt(klon,klev) 60 REAL,ALLOCATABLE,SAVE :: t(:,:) 61 !$OMP THREADPRIVATE(t) 62 ! 63 REAL rlon(klon), rlat(klon), dtime 64 REAL zx_tmp_3d(iim,jjm+1,klev),zx_tmp_2d(iim,jjm+1) 65 66 ! Couche limite: 67 ! -------------- 68 ! 69 REAL cdragh(klon) ! cdrag 70 REAL pcoefh(klon,klev) ! coeff melange CL 71 REAL pcoefh_buf(klon,klev) ! coeff melange CL + cdrag 72 REAL yv1(klon) 73 REAL yu1(klon),pphis(klon),paire(klon) 74 75 ! Les Thermiques : (Abderr 25 11 02) 76 ! --------------- 77 REAL, INTENT(IN) :: pfm_therm(klon,klev+1) 78 REAL pentr_therm(klon,klev) 79 80 REAL,ALLOCATABLE,SAVE :: entr_therm(:,:) 81 REAL,ALLOCATABLE,SAVE :: fm_therm(:,:) 82 !$OMP THREADPRIVATE(entr_therm) 83 !$OMP THREADPRIVATE(fm_therm) 84 ! 85 ! Lessivage: 86 ! ---------- 87 ! 88 REAL frac_impa(klon,klev) 89 REAL frac_nucl(klon,klev) 90 ! 91 ! Arguments necessaires pour les sources et puits de traceur 92 ! 93 REAL ftsol(klon,nbsrf) ! Temperature du sol (surf)(Kelvin) 94 REAL pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol) 95 !====================================================================== 96 ! 97 INTEGER i, k, kk 98 REAL,ALLOCATABLE,SAVE :: mfu(:,:) ! flux de masse dans le panache montant 99 REAL,ALLOCATABLE,SAVE :: mfd(:,:) ! flux de masse dans le panache descendant 100 REAL,ALLOCATABLE,SAVE :: en_u(:,:) ! flux entraine dans le panache montant 101 REAL,ALLOCATABLE,SAVE :: de_u(:,:) ! flux detraine dans le panache montant 102 REAL,ALLOCATABLE,SAVE :: en_d(:,:) ! flux entraine dans le panache descendant 103 REAL,ALLOCATABLE,SAVE :: de_d(:,:) ! flux detraine dans le panache descendant 104 REAL,ALLOCATABLE,SAVE :: coefh(:,:) ! flux detraine dans le panache descendant 105 106 REAL,ALLOCATABLE,SAVE :: pyu1(:) 107 REAL,ALLOCATABLE,SAVE :: pyv1(:) 108 REAL,ALLOCATABLE,SAVE :: pftsol(:,:) 109 REAL,ALLOCATABLE,SAVE :: ppsrf(:,:) 110 !$OMP THREADPRIVATE(mfu,mfd,en_u,de_u,en_d,de_d,coefh) 111 !$OMP THREADPRIVATE(pyu1,pyv1,pftsol,ppsrf) 112 113 114 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: sh 115 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: da 116 REAL,DIMENSION(:,:,:), ALLOCATABLE,SAVE :: phi 117 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: mp 118 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: upwd 119 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: dnwd 120 121 REAL, SAVE :: dtcum 122 INTEGER, SAVE:: iadvtr=0 123 !$OMP THREADPRIVATE(dtcum,iadvtr) 124 REAL zmin,zmax 125 LOGICAL ok_sync 126 CHARACTER(len=12) :: nvar 127 ! 128 !====================================================================== 129 130 iadvtr=iadvtr+1 131 132 ! Dans le meme vecteur on recombine le drag et les coeff d'echange 133 pcoefh_buf(:,1) = cdragh(:) 134 pcoefh_buf(:,2:klev) = pcoefh(:,2:klev) 135 136 ok_sync = .TRUE. 137 138 ! Initialization done only once 139 !====================================================================== 140 IF (iadvtr==1) THEN 141 ALLOCATE( t(klon,klev)) 142 ALLOCATE( mfu(klon,klev)) 143 ALLOCATE( mfd(klon,klev)) 144 ALLOCATE( en_u(klon,klev)) 145 ALLOCATE( de_u(klon,klev)) 146 ALLOCATE( en_d(klon,klev)) 147 ALLOCATE( de_d(klon,klev)) 148 ALLOCATE( coefh(klon,klev)) 149 ALLOCATE( entr_therm(klon,klev)) 150 ALLOCATE( fm_therm(klon,klev)) 151 ALLOCATE( pyu1(klon)) 152 ALLOCATE( pyv1(klon)) 153 ALLOCATE( pftsol(klon,nbsrf)) 154 ALLOCATE( ppsrf(klon,nbsrf)) 155 156 ALLOCATE(sh(klon,klev)) 157 ALLOCATE(da(klon,klev)) 158 ALLOCATE(phi(klon,klev,klev)) 159 ALLOCATE(mp(klon,klev)) 160 ALLOCATE(upwd(klon,klev)) 161 ALLOCATE(dnwd(klon,klev)) 162 163 CALL initphysto('phystoke', dtime, dtime*istphy,dtime*istphy,physid) 164 165 ! Write field phis and aire only once 166 CALL histwrite_phy(physid,"phis",itap,pphis) 167 CALL histwrite_phy(physid,"aire",itap,paire) 168 CALL histwrite_phy(physid,"longitudes",itap,rlon) 169 CALL histwrite_phy(physid,"latitudes",itap,rlat) 170 171 END IF 172 173 174 ! Set to zero cumulating fields 175 !====================================================================== 176 IF (MOD(iadvtr,istphy)==1.OR.istphy==1) THEN 177 WRITE(lunout,*)'reinitialisation des champs cumules a iadvtr=',iadvtr 178 mfu(:,:)=0. 179 mfd(:,:)=0. 180 en_u(:,:)=0. 181 de_u(:,:)=0. 182 en_d(:,:)=0. 183 de_d(:,:)=0. 184 coefh(:,:)=0. 185 t(:,:)=0. 186 fm_therm(:,:)=0. 187 entr_therm(:,:)=0. 188 pyv1(:)=0. 189 pyu1(:)=0. 190 pftsol(:,:)=0. 191 ppsrf(:,:)=0. 192 sh(:,:)=0. 193 da(:,:)=0. 194 phi(:,:,:)=0. 195 mp(:,:)=0. 196 upwd(:,:)=0. 197 dnwd(:,:)=0. 198 dtcum=0. 199 ENDIF 200 201 202 ! Cumulate fields at each time step 203 !====================================================================== 204 DO k=1,klev 205 DO i=1,klon 206 mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys 207 mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys 208 en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys 209 de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys 210 en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys 211 de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys 212 coefh(i,k)=coefh(i,k)+pcoefh_buf(i,k)*pdtphys 213 t(i,k)=t(i,k)+pt(i,k)*pdtphys 214 fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys 215 entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys 216 sh(i,k) = sh(i,k) + psh(i,k)*pdtphys 217 da(i,k) = da(i,k) + pda(i,k)*pdtphys 218 mp(i,k) = mp(i,k) + pmp(i,k)*pdtphys 219 upwd(i,k) = upwd(i,k) + pupwd(i,k)*pdtphys 220 dnwd(i,k) = dnwd(i,k) + pdnwd(i,k)*pdtphys 221 ENDDO 222 ENDDO 223 224 DO kk=1,klev 225 DO k=1,klev 226 DO i=1,klon 227 phi(i,k,kk) = phi(i,k,kk) + pphi(i,k,kk)*pdtphys 228 END DO 229 END DO 230 END DO 231 232 DO i=1,klon 233 pyv1(i)=pyv1(i)+yv1(i)*pdtphys 234 pyu1(i)=pyu1(i)+yu1(i)*pdtphys 235 END DO 236 DO k=1,nbsrf 237 DO i=1,klon 238 pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys 239 ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys 240 ENDDO 241 ENDDO 242 243 ! Add time step to cumulated time 244 dtcum=dtcum+pdtphys 245 246 247 ! Write fields to file, if it is time to do so 248 !====================================================================== 249 IF(MOD(iadvtr,istphy)==0) THEN 250 251 ! normalize with time period 252 DO k=1,klev 253 DO i=1,klon 254 mfu(i,k)=mfu(i,k)/dtcum 255 mfd(i,k)=mfd(i,k)/dtcum 256 en_u(i,k)=en_u(i,k)/dtcum 257 de_u(i,k)=de_u(i,k)/dtcum 258 en_d(i,k)=en_d(i,k)/dtcum 259 de_d(i,k)=de_d(i,k)/dtcum 260 coefh(i,k)=coefh(i,k)/dtcum 261 t(i,k)=t(i,k)/dtcum 262 fm_therm(i,k)=fm_therm(i,k)/dtcum 263 entr_therm(i,k)=entr_therm(i,k)/dtcum 264 sh(i,k)=sh(i,k)/dtcum 265 da(i,k)=da(i,k)/dtcum 266 mp(i,k)=mp(i,k)/dtcum 267 upwd(i,k)=upwd(i,k)/dtcum 268 dnwd(i,k)=dnwd(i,k)/dtcum 269 ENDDO 270 ENDDO 271 DO kk=1,klev 272 DO k=1,klev 273 DO i=1,klon 274 phi(i,k,kk) = phi(i,k,kk)/dtcum 275 END DO 276 END DO 277 END DO 278 DO i=1,klon 279 pyv1(i)=pyv1(i)/dtcum 280 pyu1(i)=pyu1(i)/dtcum 281 END DO 282 DO k=1,nbsrf 283 DO i=1,klon 284 pftsol(i,k)=pftsol(i,k)/dtcum 285 ppsrf(i,k)=ppsrf(i,k)/dtcum 286 ENDDO 287 ENDDO 288 289 ! write fields 290 CALL histwrite_phy(physid,"t",itap,t) 291 CALL histwrite_phy(physid,"mfu",itap,mfu) 292 CALL histwrite_phy(physid,"mfd",itap,mfd) 293 CALL histwrite_phy(physid,"en_u",itap,en_u) 294 CALL histwrite_phy(physid,"de_u",itap,de_u) 295 CALL histwrite_phy(physid,"en_d",itap,en_d) 296 CALL histwrite_phy(physid,"de_d",itap,de_d) 297 CALL histwrite_phy(physid,"coefh",itap,coefh) 298 CALL histwrite_phy(physid,"fm_th",itap,fm_therm) 299 CALL histwrite_phy(physid,"en_th",itap,entr_therm) 300 CALL histwrite_phy(physid,"frac_impa",itap,frac_impa) 301 CALL histwrite_phy(physid,"frac_nucl",itap,frac_nucl) 302 CALL histwrite_phy(physid,"pyu1",itap,pyu1) 303 CALL histwrite_phy(physid,"pyv1",itap,pyv1) 304 CALL histwrite_phy(physid,"ftsol1",itap,pftsol(:,1)) 305 CALL histwrite_phy(physid,"ftsol2",itap,pftsol(:,2)) 306 CALL histwrite_phy(physid,"ftsol3",itap,pftsol(:,3)) 307 CALL histwrite_phy(physid,"ftsol4",itap,pftsol(:,4)) 308 CALL histwrite_phy(physid,"psrf1",itap,ppsrf(:,1)) 309 CALL histwrite_phy(physid,"psrf2",itap,ppsrf(:,2)) 310 CALL histwrite_phy(physid,"psrf3",itap,ppsrf(:,3)) 311 CALL histwrite_phy(physid,"psrf4",itap,ppsrf(:,4)) 312 CALL histwrite_phy(physid,"sh",itap,sh) 313 CALL histwrite_phy(physid,"da",itap,da) 314 CALL histwrite_phy(physid,"mp",itap,mp) 315 CALL histwrite_phy(physid,"upwd",itap,upwd) 316 CALL histwrite_phy(physid,"dnwd",itap,dnwd) 317 318 319 ! phi 320 DO k=1,klev 321 IF (k<10) THEN 322 WRITE(nvar,'(i1)') k 323 ELSE IF (k<100) THEN 324 WRITE(nvar,'(i2)') k 325 ELSE 326 WRITE(nvar,'(i3)') k 327 END IF 328 nvar='phi_lev'//trim(nvar) 329 330 CALL histwrite_phy(physid,nvar,itap,phi(:,:,k)) 331 END DO 332 333 ! Syncronize file 334 !$OMP MASTER 335 IF (ok_sync) CALL histsync(physid) 336 !$OMP END MASTER 337 338 339 ! Calculate min and max values for some fields (coefficients de lessivage) 340 zmin=1e33 341 zmax=-1e33 342 DO k=1,klev 343 DO i=1,klon 344 zmax=MAX(zmax,frac_nucl(i,k)) 345 zmin=MIN(zmin,frac_nucl(i,k)) 346 ENDDO 347 ENDDO 348 WRITE(lunout,*)'------ coefs de lessivage (min et max) --------' 349 WRITE(lunout,*)'facteur de nucleation ',zmin,zmax 350 zmin=1e33 351 zmax=-1e33 352 DO k=1,klev 353 DO i=1,klon 354 zmax=MAX(zmax,frac_impa(i,k)) 355 zmin=MIN(zmin,frac_impa(i,k)) 356 ENDDO 357 ENDDO 358 WRITE(lunout,*)'facteur d impaction ',zmin,zmax 359 360 ENDIF ! IF(MOD(iadvtr,istphy)==0) 361 362 END SUBROUTINE phystokenc -
LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmd/phytrac.F90
r1444 r1447 66 66 !-------- 67 67 REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature 68 REAL,DIMENSION(klon,klev),INTENT(IN) :: u ! 69 REAL,DIMENSION(klon,klev),INTENT(IN) :: v ! 68 REAL,DIMENSION(klon,klev),INTENT(IN) :: u ! variable not used 69 REAL,DIMENSION(klon,klev),INTENT(IN) :: v ! variable not used 70 70 REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique 71 71 REAL,DIMENSION(klon,klev),INTENT(IN) :: rh ! humidite relative … … 118 118 !-------------- 119 119 ! 120 REAL,DIMENSION(klon ,klev),INTENT(IN):: cdragh ! coeff drag pour T et Q120 REAL,DIMENSION(klon),INTENT(IN) :: cdragh ! coeff drag pour T et Q 121 121 REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh ! coeff melange CL (m**2/s) 122 122 REAL,DIMENSION(klon),INTENT(IN) :: yu1 ! vents au premier niveau … … 213 213 SELECT CASE(type_trac) 214 214 CASE('lmdz') 215 !IM ajout t_seri, pplay, sh CALL traclmdz_init(pctsrf, ftsol, tr_seri, aerosol, lessivage)216 215 CALL traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage) 217 216 CASE('inca') -
LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmd/traclmdz_mod.F90
r1444 r1447 313 313 !-------------- 314 314 ! 315 REAL,DIMENSION(klon ,klev),INTENT(IN):: cdragh ! coeff drag pour T et Q315 REAL,DIMENSION(klon),INTENT(IN) :: cdragh ! coeff drag pour T et Q 316 316 REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh ! coeff melange CL (m**2/s) 317 317 REAL,DIMENSION(klon),INTENT(IN) :: yu1 ! vents au premier niveau
Note: See TracChangeset
for help on using the changeset viewer.
