Changeset 1508 for trunk/LMDZ.COMMON/libf/dyn3d_common
- Timestamp:
- Jan 15, 2016, 8:27:16 AM (9 years ago)
- Location:
- trunk/LMDZ.COMMON/libf/dyn3d_common
- Files:
-
- 2 added
- 1 deleted
- 2 edited
- 5 moved
-
covcont.F90 (moved) (moved from trunk/LMDZ.COMMON/libf/dyn3d_common/covcont.F) (1 diff)
-
dynetat0.F90 (moved) (moved from trunk/LMDZ.COMMON/libf/dyn3d_common/dynetat0.F) (8 diffs)
-
dynredem.F90 (moved) (moved from trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem.F) (3 diffs)
-
dynredem_mod.F90 (added)
-
grid_atob.F (deleted)
-
infotrac.F90 (modified) (18 diffs)
-
iniacademic.F90 (modified) (2 diffs)
-
iso_verif_dyn.F (added)
-
misc_mod.F90 (moved) (moved from trunk/LMDZ.COMMON/libf/misc/misc_mod.F90)
-
pression.F90 (moved) (moved from trunk/LMDZ.COMMON/libf/dyn3d_common/pression.F) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.COMMON/libf/dyn3d_common/covcont.F90
r1506 r1508 1 SUBROUTINE covcont (klevel,ucov, vcov, ucont, vcont ) 1 2 ! 2 ! $Header$ 3 ! 4 SUBROUTINE covcont (klevel,ucov, vcov, ucont, vcont ) 5 IMPLICIT NONE 3 !------------------------------------------------------------------------------- 4 ! Author: P. Le Van 5 !------------------------------------------------------------------------------- 6 ! Purpose: Compute contravariant components from covariant components. 7 !------------------------------------------------------------------------------- 8 IMPLICIT NONE 9 include "dimensions.h" 10 include "paramet.h" 11 include "comgeom.h" 12 !=============================================================================== 13 ! Arguments: 14 INTEGER, INTENT(IN) :: klevel !--- VERTICAL LEVELS NUMBER 15 REAL, INTENT(IN) :: ucov ( ip1jmp1,klevel ) !--- U COVARIANT WIND 16 REAL, INTENT(IN) :: vcov ( ip1jm ,klevel ) !--- V COVARIANT WIND 17 REAL, INTENT(OUT) :: ucont( ip1jmp1,klevel ) !--- U CONTRAVAR WIND 18 REAL, INTENT(OUT) :: vcont( ip1jm ,klevel ) !--- V CONTRAVAR WIND 19 !=============================================================================== 20 ! Local variables: 21 INTEGER :: l 22 !=============================================================================== 23 DO l=1,klevel 24 ucont(iip2:ip1jm,l)=ucov(iip2:ip1jm,l) * unscu2(iip2:ip1jm) 25 vcont( 1:ip1jm,l)=vcov( 1:ip1jm,l) * unscv2( 1:ip1jm) 26 END DO 6 27 7 c======================================================================= 8 c 9 c Auteur: P. Le Van 10 c ------- 11 c 12 c Objet: 13 c ------ 14 c 15 c ********************************************************************* 16 c calcul des compos. contravariantes a partir des comp.covariantes 17 c ******************************************************************** 18 c 19 c======================================================================= 28 END SUBROUTINE covcont 20 29 21 #include "dimensions.h"22 #include "paramet.h"23 #include "comgeom.h"24 25 INTEGER klevel26 REAL ucov( ip1jmp1,klevel ), vcov( ip1jm,klevel )27 REAL ucont( ip1jmp1,klevel ), vcont( ip1jm,klevel )28 INTEGER l,ij29 30 31 DO 10 l = 1,klevel32 33 DO 2 ij = iip2, ip1jm34 ucont( ij,l ) = ucov( ij,l ) * unscu2( ij )35 2 CONTINUE36 37 DO 4 ij = 1,ip1jm38 vcont( ij,l ) = vcov( ij,l ) * unscv2( ij )39 4 CONTINUE40 41 10 CONTINUE42 RETURN43 END -
trunk/LMDZ.COMMON/libf/dyn3d_common/dynetat0.F90
r1506 r1508 2 2 ! $Id $ 3 3 ! 4 SUBROUTINE dynetat0(fichnom,vcov,ucov, 5 . teta,q,masse,ps,phis,time0) 6 7 USE infotrac, only: tname, nqtot 8 use netcdf, only: nf90_open,NF90_NOWRITE,nf90_noerr,nf90_strerror, 9 & nf90_get_var, nf90_inq_varid, nf90_inq_dimid, 10 & nf90_inquire_dimension,nf90_close 4 SUBROUTINE dynetat0(fichnom,vcov,ucov,teta,q,masse,ps,phis,time0) 5 6 USE infotrac, only: tname, nqtot, zone_num, iso_indnum,& 7 iso_num, phase_num, alpha_ideal, iqiso, & 8 ok_isotopes, iqpere, tnat 9 use netcdf, only: nf90_open,NF90_NOWRITE,nf90_noerr,nf90_strerror, & 10 nf90_get_var, nf90_inq_varid, nf90_inq_dimid, & 11 nf90_inquire_dimension,nf90_close 11 12 12 13 use control_mod, only : planet_type, timestart 13 14 USE comvert_mod, ONLY: pa,preff 14 USE comconst_mod, ONLY: im,jm,lllm,daysec,dtvr, 15 .rad,omeg,g,cpp,kappa,pi15 USE comconst_mod, ONLY: im,jm,lllm,daysec,dtvr, & 16 rad,omeg,g,cpp,kappa,pi 16 17 USE logic_mod, ONLY: fxyhypb,ysinus 17 18 USE serre_mod, ONLY: clon,clat,grossismx,grossismy 18 USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn, 19 .start_time,day_ini,hour_ini19 USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn, & 20 start_time,day_ini,hour_ini 20 21 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 21 22 22 23 IMPLICIT NONE 23 24 24 c======================================================================= 25 c 26 c Auteur: P. Le Van / L.Fairhead 27 c ------- 28 c 29 c objet: 30 c ------ 31 c 32 c Lecture de l'etat initial 33 c 34 c======================================================================= 35 c----------------------------------------------------------------------- 36 c Declarations: 37 c ------------- 38 39 #include "dimensions.h" 40 #include "paramet.h" 41 #include "comgeom2.h" 42 #include "netcdf.inc" 43 #include "iniprint.h" 44 45 c Arguments: 46 c ---------- 47 48 CHARACTER(len=*),INTENT(IN) :: fichnom 49 REAL,INTENT(OUT) :: vcov(iip1,jjm,llm) 50 REAL,INTENT(OUT) :: ucov(iip1,jjp1,llm) 51 REAL,INTENT(OUT) :: teta(iip1,jjp1,llm) 52 REAL,INTENT(OUT) :: q(iip1,jjp1,llm,nqtot) 53 REAL,INTENT(OUT) :: masse(iip1,jjp1,llm) 54 REAL,INTENT(OUT) :: ps(iip1,jjp1) 55 REAL,INTENT(OUT) :: phis(iip1,jjp1) 56 REAL,INTENT(OUT) :: time0 57 58 c Variables 59 c 60 INTEGER length,iq 61 PARAMETER (length = 100) 62 REAL tab_cntrl(length) ! tableau des parametres du run 63 INTEGER ierr, nid, nvarid 64 65 character(len=12) :: start_file_type="earth" ! default start file type 66 INTEGER idecal 67 68 69 REAL,ALLOCATABLE :: time(:) ! times stored in start 70 INTEGER timelen ! number of times stored in the file 71 INTEGER indextime ! index of selected time 72 !REAL hour_ini ! fraction of day of stored date. Equivalent of day_ini, but 0=<hour_ini<1 73 74 INTEGER edges(4),corner(4) 75 integer :: i 76 77 c----------------------------------------------------------------------- 78 79 c Ouverture NetCDF du fichier etat initial 80 81 ierr=nf90_open(fichnom,NF90_NOWRITE,nid) 82 IF (ierr.NE.nf90_noerr) THEN 83 write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc' 84 write(lunout,*)trim(nf90_strerror(ierr)) 85 CALL ABORT_gcm("dynetat0", "", 1) 86 ENDIF 87 88 c 89 ierr = nf90_inq_varid (nid, "controle", nvarid) 90 IF (ierr .NE. nf90_noerr) THEN 91 write(lunout,*)"dynetat0: Le champ <controle> est absent" 92 write(lunout,*)trim(nf90_strerror(ierr)) 93 CALL ABORT_gcm("dynetat0", "", 1) 94 ENDIF 95 ierr = nf90_get_var(nid, nvarid, tab_cntrl) 96 IF (ierr .NE. nf90_noerr) THEN 97 write(lunout,*)"dynetat0: Lecture echoue pour <controle>" 98 write(lunout,*)trim(nf90_strerror(ierr)) 99 CALL ABORT_gcm("dynetat0", "", 1) 100 ENDIF 25 !======================================================================= 26 ! 27 ! Read initial confitions file 28 ! 29 !======================================================================= 30 31 include "dimensions.h" 32 include "paramet.h" 33 include "comgeom2.h" 34 include "iniprint.h" 35 36 !=============================================================================== 37 ! Arguments: 38 CHARACTER(LEN=*), INTENT(IN) :: fichnom !--- FILE NAME 39 REAL, INTENT(OUT) :: vcov(iip1,jjm, llm) !--- V COVARIANT WIND 40 REAL, INTENT(OUT) :: ucov(iip1,jjp1,llm) !--- U COVARIANT WIND 41 REAL, INTENT(OUT) :: teta(iip1,jjp1,llm) !--- POTENTIAL TEMP. 42 REAL, INTENT(OUT) :: q(iip1,jjp1,llm,nqtot) !--- TRACERS 43 REAL, INTENT(OUT) :: masse(iip1,jjp1,llm) !--- MASS PER CELL 44 REAL, INTENT(OUT) :: ps(iip1,jjp1) !--- GROUND PRESSURE 45 REAL, INTENT(OUT) :: phis(iip1,jjp1) !--- GEOPOTENTIAL 46 REAL,INTENT(OUT) :: time0 47 !=============================================================================== 48 ! Local Variables 49 CHARACTER(LEN=256) :: msg, var, modname 50 INTEGER,PARAMETER :: length=100 51 INTEGER :: iq, fID, vID, idecal 52 REAL :: tab_cntrl(length) ! array containing run parameters 53 INTEGER :: ierr 54 CHARACTER(len=12) :: start_file_type="earth" ! default start file type 55 56 REAL,ALLOCATABLE :: time(:) ! times stored in start 57 INTEGER :: timelen ! number of times stored in the file 58 INTEGER :: indextime ! index of selected time 59 !REAL hour_ini ! fraction of day of stored date. Equivalent of day_ini, but 0=<hour_ini<1 60 61 INTEGER :: edges(4),corner(4) 62 INTEGER :: i 63 64 !----------------------------------------------------------------------- 65 modname="dynetat0" 66 67 ! Open initial state NetCDF file 68 var=fichnom 69 CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var) 70 ! 71 CALL get_var1("controle",tab_cntrl) 101 72 102 73 !!! AS: idecal is a hack to be able to read planeto starts... … … 137 108 pa = tab_cntrl(idecal+13) 138 109 preff = tab_cntrl(idecal+14) 139 c 110 ! 140 111 clon = tab_cntrl(idecal+15) 141 112 clat = tab_cntrl(idecal+16) 142 113 grossismx = tab_cntrl(idecal+17) 143 114 grossismy = tab_cntrl(idecal+18) 144 c 115 ! 145 116 IF ( tab_cntrl(idecal+19).EQ.1. ) THEN 146 fxyhypb = . TRUE.147 cdzoomx = tab_cntrl(25)148 cdzoomy = tab_cntrl(26)149 ctaux = tab_cntrl(28)150 ctauy = tab_cntrl(29)117 fxyhypb = .TRUE. 118 ! dzoomx = tab_cntrl(25) 119 ! dzoomy = tab_cntrl(26) 120 ! taux = tab_cntrl(28) 121 ! tauy = tab_cntrl(29) 151 122 ELSE 152 fxyhypb = . FALSE.153 ysinus = . FALSE.154 IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . 123 fxyhypb = .FALSE. 124 ysinus = .FALSE. 125 IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = .TRUE. 155 126 ENDIF 156 127 … … 170 141 start_time=0 171 142 endif 172 c ................................................................. 173 c 174 c 175 write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa ', 176 & rad,omeg,g,cpp,kappa 177 178 IF( im.ne.iim ) THEN 179 PRINT 1,im,iim 180 STOP 181 ELSE IF( jm.ne.jjm ) THEN 182 PRINT 2,jm,jjm 183 STOP 184 ELSE IF( lllm.ne.llm ) THEN 185 PRINT 3,lllm,llm 186 STOP 187 ENDIF 188 189 ierr=nf90_inq_varid(nid, "rlonu", nvarid) 190 IF (ierr .NE. nf90_noerr) THEN 191 write(lunout,*)"dynetat0: Le champ <rlonu> est absent" 192 write(lunout,*)trim(nf90_strerror(ierr)) 193 CALL ABORT_gcm("dynetat0", "", 1) 194 ENDIF 195 ierr = nf90_get_var(nid, nvarid, rlonu) 196 IF (ierr .NE. nf90_noerr) THEN 197 write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>" 198 write(lunout,*)trim(nf90_strerror(ierr)) 199 CALL ABORT_gcm("dynetat0", "", 1) 200 ENDIF 201 202 ierr = nf90_inq_varid (nid, "rlatu", nvarid) 203 IF (ierr .NE. nf90_noerr) THEN 204 write(lunout,*)"dynetat0: Le champ <rlatu> est absent" 205 write(lunout,*)trim(nf90_strerror(ierr)) 206 CALL ABORT_gcm("dynetat0", "", 1) 207 ENDIF 208 ierr = nf90_get_var(nid, nvarid, rlatu) 209 IF (ierr .NE. nf90_noerr) THEN 210 write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>" 211 write(lunout,*)trim(nf90_strerror(ierr)) 212 CALL ABORT_gcm("dynetat0", "", 1) 213 ENDIF 214 215 ierr = nf90_inq_varid (nid, "rlonv", nvarid) 216 IF (ierr .NE. nf90_noerr) THEN 217 write(lunout,*)"dynetat0: Le champ <rlonv> est absent" 218 write(lunout,*)trim(nf90_strerror(ierr)) 219 CALL ABORT_gcm("dynetat0", "", 1) 220 ENDIF 221 ierr = nf90_get_var(nid, nvarid, rlonv) 222 IF (ierr .NE. nf90_noerr) THEN 223 write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>" 224 write(lunout,*)trim(nf90_strerror(ierr)) 225 CALL ABORT_gcm("dynetat0", "", 1) 226 ENDIF 227 228 ierr = nf90_inq_varid (nid, "rlatv", nvarid) 229 IF (ierr .NE. nf90_noerr) THEN 230 write(lunout,*)"dynetat0: Le champ <rlatv> est absent" 231 write(lunout,*)trim(nf90_strerror(ierr)) 232 CALL ABORT_gcm("dynetat0", "", 1) 233 ENDIF 234 ierr = nf90_get_var(nid, nvarid, rlatv) 235 IF (ierr .NE. nf90_noerr) THEN 236 write(lunout,*)"dynetat0: Lecture echouee pour rlatv" 237 write(lunout,*)trim(nf90_strerror(ierr)) 238 CALL ABORT_gcm("dynetat0", "", 1) 239 ENDIF 240 241 ierr = nf90_inq_varid (nid, "cu", nvarid) 242 IF (ierr .NE. nf90_noerr) THEN 243 write(lunout,*)"dynetat0: Le champ <cu> est absent" 244 write(lunout,*)trim(nf90_strerror(ierr)) 245 CALL ABORT_gcm("dynetat0", "", 1) 246 ENDIF 247 ierr = nf90_get_var(nid, nvarid, cu) 248 IF (ierr .NE. nf90_noerr) THEN 249 write(lunout,*)"dynetat0: Lecture echouee pour <cu>" 250 write(lunout,*)trim(nf90_strerror(ierr)) 251 CALL ABORT_gcm("dynetat0", "", 1) 252 ENDIF 253 254 ierr = nf90_inq_varid (nid, "cv", nvarid) 255 IF (ierr .NE. nf90_noerr) THEN 256 write(lunout,*)"dynetat0: Le champ <cv> est absent" 257 write(lunout,*)trim(nf90_strerror(ierr)) 258 CALL ABORT_gcm("dynetat0", "", 1) 259 ENDIF 260 ierr = nf90_get_var(nid, nvarid, cv) 261 IF (ierr .NE. nf90_noerr) THEN 262 write(lunout,*)"dynetat0: Lecture echouee pour <cv>" 263 write(lunout,*)trim(nf90_strerror(ierr)) 264 CALL ABORT_gcm("dynetat0", "", 1) 265 ENDIF 266 267 ierr = nf90_inq_varid (nid, "aire", nvarid) 268 IF (ierr .NE. nf90_noerr) THEN 269 write(lunout,*)"dynetat0: Le champ <aire> est absent" 270 write(lunout,*)trim(nf90_strerror(ierr)) 271 CALL ABORT_gcm("dynetat0", "", 1) 272 ENDIF 273 ierr = nf90_get_var(nid, nvarid, aire) 274 IF (ierr .NE. nf90_noerr) THEN 275 write(lunout,*)"dynetat0: Lecture echouee pour <aire>" 276 write(lunout,*)trim(nf90_strerror(ierr)) 277 CALL ABORT_gcm("dynetat0", "", 1) 278 ENDIF 279 280 ierr = nf90_inq_varid (nid, "phisinit", nvarid) 281 IF (ierr .NE. nf90_noerr) THEN 282 write(lunout,*)"dynetat0: Le champ <phisinit> est absent" 283 write(lunout,*)trim(nf90_strerror(ierr)) 284 CALL ABORT_gcm("dynetat0", "", 1) 285 ENDIF 286 ierr = nf90_get_var(nid, nvarid, phis) 287 IF (ierr .NE. nf90_noerr) THEN 288 write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>" 289 write(lunout,*)trim(nf90_strerror(ierr)) 290 CALL ABORT_gcm("dynetat0", "", 1) 291 ENDIF 143 ! ................................................................. 144 ! 145 ! 146 WRITE(lunout,*)trim(modname)//': rad,omeg,g,cpp,kappa ', & 147 rad,omeg,g,cpp,kappa 148 149 CALL check_dim(im,iim,'im','iim') 150 CALL check_dim(jm,jjm,'jm','jjm') 151 CALL check_dim(llm,lllm,'llm','lllm') 152 153 CALL get_var1("rlonu",rlonu) 154 CALL get_var1("rlatu",rlatu) 155 CALL get_var1("rlonv",rlonv) 156 CALL get_var1("rlatv",rlatv) 157 158 CALL get_var2("cu" ,cu) 159 CALL get_var2("cv" ,cv) 160 161 CALL get_var2("aire" ,aire) 162 CALL get_var2("phisinit",phis) 292 163 293 164 ! read time axis 294 ierr = nf90_inq_varid ( nid, "temps", nvarid)165 ierr = nf90_inq_varid (fID, "temps", vID) 295 166 IF (ierr .NE. nf90_noerr) THEN 296 167 write(lunout,*)"dynetat0: Le champ <temps> est absent" 297 168 write(lunout,*)"dynetat0: J essaie <Time>" 298 ierr = nf90_inq_varid ( nid, "Time", nvarid)169 ierr = nf90_inq_varid (fID, "Time", vID) 299 170 IF (ierr .NE. nf90_noerr) THEN 300 171 write(lunout,*)"dynetat0: Le champ <Time> est absent" … … 303 174 ENDIF 304 175 ! Get the length of the "Time" dimension 305 ierr = nf90_inq_dimid( nid,"Time",nvarid)306 ierr = nf90_inquire_dimension( nid,nvarid,len=timelen)176 ierr = nf90_inq_dimid(fID,"Time",vID) 177 ierr = nf90_inquire_dimension(fID,vID,len=timelen) 307 178 allocate(time(timelen)) 308 179 ! Then look for the "Time" variable 309 ierr =nf90_inq_varid( nid,"Time",nvarid)310 ierr = nf90_get_var( nid, nvarid, time)180 ierr =nf90_inq_varid(fID,"Time",vID) 181 ierr = nf90_get_var(fID, vID, time) 311 182 IF (ierr .NE. nf90_noerr) THEN 312 183 write(lunout,*)"dynetat0: Lecture echouee <Time>" … … 316 187 ELSE 317 188 ! Get the length of the "temps" dimension 318 ierr = nf90_inq_dimid( nid,"temps",nvarid)319 ierr = nf90_inquire_dimension( nid,nvarid,len=timelen)189 ierr = nf90_inq_dimid(fID,"temps",vID) 190 ierr = nf90_inquire_dimension(fID,vID,len=timelen) 320 191 allocate(time(timelen)) 321 192 ! Then look for the "temps" variable 322 ierr = nf90_inq_varid ( nid, "temps", nvarid)323 ierr = nf90_get_var( nid, nvarid, time)193 ierr = nf90_inq_varid (fID, "temps", vID) 194 ierr = nf90_get_var(fID, vID, time) 324 195 IF (ierr .NE. nf90_noerr) THEN 325 196 write(lunout,*)"dynetat0: Lecture echouee <temps>" … … 341 212 ENDDO 342 213 IF (indextime .eq. 0) THEN 343 write(lunout,*)"Time", timestart," is not in " 344 &//trim(fichnom)//"!!"214 write(lunout,*)"Time", timestart," is not in " & 215 //trim(fichnom)//"!!" 345 216 write(lunout,*)"Stored times are:" 346 217 DO i=1,timelen … … 362 233 endif 363 234 364 PRINT*, "dynetat0: Selected time ",time(indextime), 365 ." at index ",indextime235 PRINT*, "dynetat0: Selected time ",time(indextime), & 236 " at index ",indextime 366 237 367 238 DEALLOCATE(time) 368 239 369 240 ! read vcov 370 corner(1)=1 371 corner(2)=1 372 corner(3)=1 373 corner(4)=indextime 374 edges(1)=iip1 375 edges(2)=jjm 376 edges(3)=llm 377 edges(4)=1 378 ierr=nf90_inq_varid(nid,"vcov",nvarid) 379 IF (ierr .NE. nf90_noerr) THEN 380 write(lunout,*)"dynetat0: Le champ <vcov> est absent" 381 write(lunout,*)trim(nf90_strerror(ierr)) 382 CALL ABORT_gcm("dynetat0", "", 1) 383 ENDIF 384 ierr=nf90_get_var(nid,nvarid,vcov,corner,edges) 385 IF (ierr .NE. nf90_noerr) THEN 386 write(lunout,*)"dynetat0: Lecture echouee pour <vcov>" 387 write(lunout,*)trim(nf90_strerror(ierr)) 388 CALL ABORT_gcm("dynetat0", "", 1) 389 ENDIF 241 CALL get_var3v_t("vcov",vcov,indextime) 390 242 391 243 ! read ucov 392 corner(1)=1 393 corner(2)=1 394 corner(3)=1 395 corner(4)=indextime 396 edges(1)=iip1 397 edges(2)=jjp1 398 edges(3)=llm 399 edges(4)=1 400 ierr=nf90_inq_varid(nid,"ucov",nvarid) 401 IF (ierr .NE. nf90_noerr) THEN 402 write(lunout,*)"dynetat0: Le champ <ucov> est absent" 403 write(lunout,*)trim(nf90_strerror(ierr)) 404 CALL ABORT_gcm("dynetat0", "", 1) 405 ENDIF 406 ierr=nf90_get_var(nid,nvarid,ucov,corner,edges) 407 IF (ierr .NE. nf90_noerr) THEN 408 write(lunout,*)"dynetat0: Lecture echouee pour <ucov>" 409 write(lunout,*)trim(nf90_strerror(ierr)) 410 CALL ABORT_gcm("dynetat0", "", 1) 411 ENDIF 244 CALL get_var3u_t("ucov",ucov,indextime) 412 245 413 246 ! read teta (same corner/edges as ucov) 414 ierr=nf90_inq_varid(nid,"teta",nvarid) 415 IF (ierr .NE. nf90_noerr) THEN 416 write(lunout,*)"dynetat0: Le champ <teta> est absent" 417 write(lunout,*)trim(nf90_strerror(ierr)) 418 CALL ABORT_gcm("dynetat0", "", 1) 419 ENDIF 420 ierr=nf90_get_var(nid,nvarid,teta,corner,edges) 421 IF (ierr .NE. nf90_noerr) THEN 422 write(lunout,*)"dynetat0: Lecture echouee pour <teta>" 423 write(lunout,*)trim(nf90_strerror(ierr)) 424 CALL ABORT_gcm("dynetat0", "", 1) 425 ENDIF 247 CALL get_var3u_t("teta",teta,indextime) 426 248 427 249 ! read tracers (same corner/edges as ucov) 428 IF(nqtot.GE.1) THEN 250 corner(1)=1 251 corner(2)=1 252 corner(3)=1 253 corner(4)=indextime 254 edges(1)=iip1 255 edges(2)=jjp1 256 edges(3)=llm 257 edges(4)=1 258 IF(nqtot.GE.1) THEN 429 259 DO iq=1,nqtot 430 ierr= nf90_inq_varid( nid,tname(iq),nvarid)260 ierr= nf90_inq_varid(fID,tname(iq),vID) 431 261 IF (ierr .NE. nf90_noerr) THEN 432 write(lunout,*)"dynetat0: Le traceur <"//trim(tname(iq))// 433 & "> est absent" 434 write(lunout,*)" Il est donc initialise a zero" 262 write(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing" 263 write(lunout,*)" It is hence initialized to zero" 435 264 q(:,:,:,iq)=0. 265 IF (planet_type=="earth") THEN 266 !--- CRisi: for isotops, theoretical initialization using very simplified 267 ! Rayleigh distillation las. 268 IF(ok_isotopes.AND.iso_num(iq)>0) THEN 269 IF(zone_num(iq)==0) q(:,:,:,iq)=q(:,:,:,iqpere(iq))*tnat(iso_num(iq)) & 270 & *(q(:,:,:,iqpere(iq))/30.e-3)**(alpha_ideal(iso_num(iq))-1) 271 IF(zone_num(iq)==1) q(:,:,:,iq)=q(:,:,:,iqiso(iso_indnum(iq),phase_num(iq))) 272 END IF 273 ENDIF 436 274 ELSE 437 ierr=nf90_get_var( nid,nvarid,q(:,:,:,iq),corner,edges)275 ierr=nf90_get_var(fID,vID,q(:,:,:,iq),corner,edges) 438 276 IF (ierr .NE. nf90_noerr) THEN 439 write(lunout,*)"dynetat0: Lecture echouee pour " 440 &//trim(tname(iq))277 write(lunout,*)"dynetat0: Lecture echouee pour " & 278 //trim(tname(iq)) 441 279 write(lunout,*)trim(nf90_strerror(ierr)) 442 280 CALL ABORT_gcm("dynetat0", "", 1) … … 444 282 ENDIF 445 283 ENDDO 446 284 ENDIF 447 285 448 286 !read masse (same corner/edges as ucov) 449 ierr=nf90_inq_varid(nid,"masse",nvarid) 450 IF (ierr .NE. nf90_noerr) THEN 451 write(lunout,*)"dynetat0: Le champ <masse> est absent" 452 write(lunout,*)trim(nf90_strerror(ierr)) 453 CALL ABORT_gcm("dynetat0", "", 1) 454 ENDIF 455 ierr=nf90_get_var(nid,nvarid,masse,corner,edges) 456 IF (ierr .NE. nf90_noerr) THEN 457 write(lunout,*)"dynetat0: Lecture echouee pour <masse>" 458 write(lunout,*)trim(nf90_strerror(ierr)) 459 CALL ABORT_gcm("dynetat0", "", 1) 460 ENDIF 461 462 ! read ps 463 corner(1)=1 464 corner(2)=1 465 corner(3)=indextime 466 edges(1)=iip1 467 edges(2)=jjp1 468 edges(3)=1 469 ierr=nf90_inq_varid(nid,"ps",nvarid) 470 IF (ierr .NE. nf90_noerr) THEN 471 write(lunout,*)"dynetat0: Le champ <ps> est absent" 472 write(lunout,*)trim(nf90_strerror(ierr)) 473 CALL ABORT_gcm("dynetat0", "", 1) 474 ENDIF 475 ierr=nf90_get_var(nid,nvarid,ps,corner,edges) 476 IF (ierr .NE. nf90_noerr) THEN 477 write(lunout,*)"dynetat0: Lecture echouee pour <ps>" 478 write(lunout,*)trim(nf90_strerror(ierr)) 479 CALL ABORT_gcm("dynetat0", "", 1) 480 ENDIF 481 482 ierr=nf90_close(nid) 483 484 if (planet_type/="mars") then 485 day_ini=day_ini+INT(time0) ! obsolete stuff ; 0<time<1 anyways 486 time0=time0-INT(time0) 487 endif 488 489 1 FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem 490 *arrage est differente de la valeur parametree iim =',i4//) 491 2 FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem 492 *arrage est differente de la valeur parametree jjm =',i4//) 493 3 FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema 494 *rrage est differente de la valeur parametree llm =',i4//) 495 4 FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema 496 *rrage est differente de la valeur dtinteg =',i4//) 497 498 RETURN 499 END 287 CALL get_var3u_t("masse",masse,indextime) 288 289 !read ps 290 CALL get_var2_t("ps",ps,indextime) 291 292 CALL err(NF90_CLOSE(fID),"close",fichnom) 293 294 if (planet_type/="mars") then 295 day_ini=day_ini+INT(time0) ! obsolete stuff ; 0<time<1 anyways 296 time0=time0-INT(time0) 297 endif 298 299 300 CONTAINS 301 302 SUBROUTINE check_dim(n1,n2,str1,str2) 303 INTEGER, INTENT(IN) :: n1, n2 304 CHARACTER(LEN=*), INTENT(IN) :: str1, str2 305 CHARACTER(LEN=256) :: s1, s2 306 IF(n1/=n2) THEN 307 s1='value of '//TRIM(str1)//' =' 308 s2=' read in starting file differs from parametrized '//TRIM(str2)//' =' 309 WRITE(msg,'(10x,a,i4,2x,a,i4)'),s1,n1,s2,n2 310 CALL ABORT_gcm(TRIM(modname),TRIM(msg),1) 311 END IF 312 END SUBROUTINE check_dim 313 314 315 SUBROUTINE get_var1(var,v) 316 CHARACTER(LEN=*), INTENT(IN) :: var 317 REAL, INTENT(OUT) :: v(:) 318 CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) 319 CALL err(NF90_GET_VAR(fID,vID,v),"get",var) 320 END SUBROUTINE get_var1 321 322 323 SUBROUTINE get_var2(var,v) 324 CHARACTER(LEN=*), INTENT(IN) :: var 325 REAL, INTENT(OUT) :: v(:,:) 326 CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) 327 CALL err(NF90_GET_VAR(fID,vID,v),"get",var) 328 END SUBROUTINE get_var2 329 330 SUBROUTINE get_var2_t(var,v,indextime) 331 CHARACTER(LEN=*), INTENT(IN) :: var 332 REAL, INTENT(OUT) :: v(:,:) 333 INTEGER, INTENT(IN) :: indextime 334 corner(1)=1 335 corner(2)=1 336 corner(3)=indextime 337 edges(1)=iip1 338 edges(2)=jjp1 339 edges(3)=1 340 CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) 341 CALL err(NF90_GET_VAR(fID,vID,v,corner,edges),"get",var) 342 END SUBROUTINE get_var2_t 343 344 345 SUBROUTINE get_var3(var,v) ! on U grid 346 CHARACTER(LEN=*), INTENT(IN) :: var 347 REAL, INTENT(OUT) :: v(:,:,:) 348 CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) 349 CALL err(NF90_GET_VAR(fID,vID,v),"get",var) 350 END SUBROUTINE get_var3 351 352 SUBROUTINE get_var3u_t(var,v,indextime) ! on U grid 353 CHARACTER(LEN=*), INTENT(IN) :: var 354 REAL, INTENT(OUT) :: v(:,:,:) 355 INTEGER, INTENT(IN) :: indextime 356 corner(1)=1 357 corner(2)=1 358 corner(3)=1 359 corner(4)=indextime 360 edges(1)=iip1 361 edges(2)=jjp1 362 edges(3)=llm 363 edges(4)=1 364 CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) 365 CALL err(NF90_GET_VAR(fID,vID,v,corner,edges),"get",var) 366 END SUBROUTINE get_var3u_t 367 368 SUBROUTINE get_var3v_t(var,v,indextime) ! on V grid 369 CHARACTER(LEN=*), INTENT(IN) :: var 370 REAL, INTENT(OUT) :: v(:,:,:) 371 INTEGER, INTENT(IN) :: indextime 372 corner(1)=1 373 corner(2)=1 374 corner(3)=1 375 corner(4)=indextime 376 edges(1)=iip1 377 edges(2)=jjm 378 edges(3)=llm 379 edges(4)=1 380 CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) 381 CALL err(NF90_GET_VAR(fID,vID,v,corner,edges),"get",var) 382 END SUBROUTINE get_var3v_t 383 384 SUBROUTINE err(ierr,typ,nam) 385 INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE 386 CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION 387 CHARACTER(LEN=*), INTENT(IN) :: nam !--- FIELD/FILE NAME 388 IF(ierr==NF90_NoERR) RETURN 389 SELECT CASE(typ) 390 CASE('inq'); msg="Field <"//TRIM(nam)//"> is missing" 391 CASE('get'); msg="Reading failed for <"//TRIM(nam)//">" 392 CASE('open'); msg="File opening failed for <"//TRIM(nam)//">" 393 CASE('close'); msg="File closing failed for <"//TRIM(nam)//">" 394 END SELECT 395 CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr) 396 END SUBROUTINE err 397 398 END SUBROUTINE dynetat0 -
trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem.F90
r1506 r1508 2 2 ! $Id: dynredem.F 1635 2012-07-12 11:37:16Z lguez $ 3 3 ! 4 c 5 4 ! 5 SUBROUTINE dynredem0(fichnom,iday_end,phis) 6 6 #ifdef CPP_IOIPSL 7 7 USE IOIPSL 8 8 #endif 9 USE infotrac 10 use netcdf95, only: NF95_PUT_VAR 11 use control_mod, only : planet_type 12 USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt,pa,preff, 13 . nivsig,nivsigs 14 USE comconst_mod, ONLY: daysec,dtvr,rad,omeg,g,cpp,kappa,pi 15 USE logic_mod, ONLY: fxyhypb,ysinus 16 USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, 17 . taux,tauy 18 USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn,itaufin, 19 . start_time,hour_ini 20 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 21 22 IMPLICIT NONE 23 c======================================================================= 24 c Ecriture du fichier de redemarrage sous format NetCDF (initialisation) 25 c======================================================================= 26 c Declarations: 27 c ------------- 28 #include "dimensions.h" 29 #include "paramet.h" 30 #include "comgeom2.h" 31 #include "netcdf.inc" 32 #include "iniprint.h" 33 34 c Arguments: 35 c ---------- 36 INTEGER iday_end 37 REAL phis(iip1, jjp1) 38 CHARACTER*(*) fichnom 39 40 c Local: 41 c ------ 42 INTEGER iq,l 43 INTEGER length 44 PARAMETER (length = 100) 45 REAL tab_cntrl(length) ! tableau des parametres du run 46 INTEGER ierr 47 character*20 modname 48 character*80 abort_message 49 50 c Variables locales pour NetCDF: 51 c 52 INTEGER dims2(2), dims3(3), dims4(4) 53 INTEGER idim_index 54 INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv 55 INTEGER idim_s, idim_sig 56 INTEGER idim_tim 57 INTEGER nid,nvarid 58 59 REAL zan0,zjulian,hours 60 INTEGER yyears0,jjour0, mmois0 61 character*30 unites 62 63 character(len=12) :: start_file_type="earth" ! default start file type 64 INTEGER idecal 65 66 c----------------------------------------------------------------------- 67 modname='dynredem0' 9 USE infotrac, ONLY: nqtot, tname, ttext 10 USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL, & 11 NF90_CLOSE, NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER 12 USE dynredem_mod, ONLY: cre_var, put_var1, put_var2, err, modname, fil 13 use netcdf95, only: NF95_PUT_VAR 14 use control_mod, only : planet_type 15 USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt,pa,preff, & 16 nivsig,nivsigs 17 USE comconst_mod, ONLY: daysec,dtvr,rad,omeg,g,cpp,kappa,pi 18 USE logic_mod, ONLY: fxyhypb,ysinus 19 USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, & 20 taux,tauy 21 USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn,itaufin, & 22 start_time,hour_ini 23 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 24 25 IMPLICIT NONE 26 !======================================================================= 27 ! Writting the NetCDF restart file (initialisation) 28 !======================================================================= 29 ! Declarations: 30 ! ------------- 31 include "dimensions.h" 32 include "paramet.h" 33 include "comgeom2.h" 34 include "netcdf.inc" 35 include "iniprint.h" 36 37 !=============================================================================== 38 ! Arguments: 39 CHARACTER(LEN=*), INTENT(IN) :: fichnom !--- FILE NAME 40 INTEGER, INTENT(IN) :: iday_end !--- 41 REAL, INTENT(IN) :: phis(iip1, jjp1) !--- GROUND GEOPOTENTIAL 42 !=============================================================================== 43 ! Local variables: 44 INTEGER :: iq,l 45 INTEGER, PARAMETER :: length=100 46 REAL :: tab_cntrl(length) ! run parameters 47 INTEGER :: ierr 48 CHARACTER(LEN=80) :: abort_message 49 50 ! For NetCDF: 51 CHARACTER(LEN=30) :: unites 52 INTEGER :: indexID 53 INTEGER :: rlonuID, rlonvID, rlatuID, rlatvID 54 INTEGER :: sID, sigID, nID, vID, timID 55 INTEGER :: yyears0, jjour0, mmois0 56 REAL :: zan0, zjulian, hours 57 58 CHARACTER(len=12) :: start_file_type="earth" ! default start file type 59 INTEGER :: idecal 60 61 !=============================================================================== 62 ! fill dynredem_mod module variables 63 modname='dynredem0'; fil=fichnom 68 64 69 65 #ifdef CPP_IOIPSL 70 71 66 call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian) 67 call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours) 72 68 #else 73 69 ! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used) 74 75 76 70 yyears0=0 71 mmois0=1 72 jjour0=1 77 73 #endif 78 74 79 !!! AS: idecal is a hack to be able to read planeto starts... 80 !!! .... while keeping everything OK for LMDZ EARTH 81 if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then 82 write(lunout,*) trim(modname),' : Planeto-like start file' 83 start_file_type="planeto" 84 idecal = 4 85 else 86 write(lunout,*) trim(modname),' : Earth-like start file' 87 idecal = 5 88 endif 89 90 DO l=1,length 91 tab_cntrl(l) = 0. 92 ENDDO 93 tab_cntrl(1) = REAL(iim) 94 tab_cntrl(2) = REAL(jjm) 95 tab_cntrl(3) = REAL(llm) 96 if (start_file_type.eq."earth") then 97 tab_cntrl(4)=REAL(day_ref) 98 else 99 !tab_cntrl(4)=REAL(day_end) 100 tab_cntrl(4)=REAL(iday_end) 101 endif 102 tab_cntrl(5) = REAL(annee_ref) 103 tab_cntrl(idecal+1) = rad 104 tab_cntrl(idecal+2) = omeg 105 tab_cntrl(idecal+3) = g 106 tab_cntrl(idecal+4) = cpp 107 tab_cntrl(idecal+5) = kappa 108 tab_cntrl(idecal+6) = daysec 109 tab_cntrl(idecal+7) = dtvr 110 tab_cntrl(idecal+8) = etot0 111 tab_cntrl(idecal+9) = ptot0 112 tab_cntrl(idecal+10) = ztot0 113 tab_cntrl(idecal+11) = stot0 114 tab_cntrl(idecal+12) = ang0 115 tab_cntrl(idecal+13) = pa 116 tab_cntrl(idecal+14) = preff 117 c 118 c ..... parametres pour le zoom ...... 119 120 tab_cntrl(idecal+15) = clon 121 tab_cntrl(idecal+16) = clat 122 tab_cntrl(idecal+17) = grossismx 123 tab_cntrl(idecal+18) = grossismy 124 c 125 IF ( fxyhypb ) THEN 126 tab_cntrl(idecal+19) = 1. 127 tab_cntrl(idecal+20) = dzoomx 128 tab_cntrl(idecal+21) = dzoomy 129 tab_cntrl(idecal+22) = 0. 130 tab_cntrl(idecal+23) = taux 131 tab_cntrl(idecal+24) = tauy 132 ELSE 133 tab_cntrl(idecal+19) = 0. 134 tab_cntrl(idecal+20) = dzoomx 135 tab_cntrl(idecal+21) = dzoomy 136 tab_cntrl(idecal+22) = 0. 137 tab_cntrl(idecal+23) = 0. 138 tab_cntrl(idecal+24) = 0. 139 IF( ysinus ) tab_cntrl(idecal+22) = 1. 140 ENDIF 141 142 if (start_file_type.eq."earth") then 143 tab_cntrl(idecal+25) = REAL(iday_end) 144 tab_cntrl(idecal+26) = REAL(itau_dyn + itaufin) 145 c start_time: start_time of simulation (not necessarily 0.) 146 tab_cntrl(idecal+27) = start_time 147 endif 148 149 if (planet_type=="mars") then ! For Mars only 150 tab_cntrl(29)=hour_ini 151 endif 152 c 153 c ......................................................... 154 c 155 c Creation du fichier: 156 c 157 ierr = NF_CREATE(fichnom, NF_CLOBBER, nid) 158 IF (ierr.NE.NF_NOERR) THEN 159 write(lunout,*)"dynredem0: Pb d ouverture du fichier " 160 & //trim(fichnom) 161 write(lunout,*)' ierr = ', ierr 162 CALL ABORT_GCM("DYNREDEM0", "", 1) 163 ENDIF 164 c 165 c Preciser quelques attributs globaux: 166 c 167 ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27, 168 . "Fichier demmarage dynamique") 169 c 170 c Definir les dimensions du fichiers: 171 c 172 if (start_file_type.eq."earth") then 173 ierr = NF_DEF_DIM (nid, "index", length, idim_index) 174 ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu) 175 ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu) 176 ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv) 177 ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv) 178 ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s) 179 ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig) 180 ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim) 181 else 182 ierr = NF_DEF_DIM (nid, "index", length, idim_index) 183 ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu) 184 ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu) 185 ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv) 186 ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv) 187 ierr = NF_DEF_DIM (nid, "altitude", llm, idim_s) 188 ierr = NF_DEF_DIM (nid, "interlayer", llmp1, idim_sig) 189 ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_tim) 190 endif 191 c 192 ierr = NF_ENDDEF(nid) ! sortir du mode de definition 193 c 194 c Definir et enregistrer certains champs invariants: 195 c 196 ierr = NF_REDEF (nid) 197 cIM 220306 BEG 198 #ifdef NC_DOUBLE 199 ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid) 200 #else 201 ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid) 202 #endif 203 cIM 220306 END 204 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, 205 . "Parametres de controle") 206 ierr = NF_ENDDEF(nid) 207 call NF95_PUT_VAR(nid,nvarid,tab_cntrl) 208 c 209 ierr = NF_REDEF (nid) 210 cIM 220306 BEG 211 #ifdef NC_DOUBLE 212 ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid) 213 #else 214 ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid) 215 #endif 216 cIM 220306 END 217 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23, 218 . "Longitudes des points U") 219 ierr = NF_ENDDEF(nid) 220 call NF95_PUT_VAR(nid,nvarid,rlonu) 221 c 222 ierr = NF_REDEF (nid) 223 cIM 220306 BEG 224 #ifdef NC_DOUBLE 225 ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid) 226 #else 227 ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid) 228 #endif 229 cIM 220306 END 230 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, 231 . "Latitudes des points U") 232 ierr = NF_ENDDEF(nid) 233 call NF95_PUT_VAR (nid,nvarid,rlatu) 234 c 235 ierr = NF_REDEF (nid) 236 cIM 220306 BEG 237 #ifdef NC_DOUBLE 238 ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid) 239 #else 240 ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid) 241 #endif 242 cIM 220306 END 243 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23, 244 . "Longitudes des points V") 245 ierr = NF_ENDDEF(nid) 246 call NF95_PUT_VAR(nid,nvarid,rlonv) 247 c 248 ierr = NF_REDEF (nid) 249 cIM 220306 BEG 250 #ifdef NC_DOUBLE 251 ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid) 252 #else 253 ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid) 254 #endif 255 cIM 220306 END 256 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, 257 . "Latitudes des points V") 258 ierr = NF_ENDDEF(nid) 259 call NF95_PUT_VAR(nid,nvarid,rlatv) 260 c 261 if (start_file_type.eq."earth") then 262 ierr = NF_REDEF (nid) 263 cIM 220306 BEG 264 #ifdef NC_DOUBLE 265 ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid) 266 #else 267 ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid) 268 #endif 269 cIM 220306 END 270 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28, 271 . "Numero naturel des couches s") 272 ierr = NF_ENDDEF(nid) 273 call NF95_PUT_VAR(nid,nvarid,nivsigs) 274 c 275 ierr = NF_REDEF (nid) 276 cIM 220306 BEG 277 #ifdef NC_DOUBLE 278 ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid) 279 #else 280 ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid) 281 #endif 282 cIM 220306 END 283 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32, 284 . "Numero naturel des couches sigma") 285 ierr = NF_ENDDEF(nid) 286 call NF95_PUT_VAR(nid,nvarid,nivsig) 287 endif ! of if (start_file_type.eq."earth") 288 c 289 ierr = NF_REDEF (nid) 290 cIM 220306 BEG 291 #ifdef NC_DOUBLE 292 ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid) 293 #else 294 ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid) 295 #endif 296 cIM 220306 END 297 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26, 298 . "Coefficient A pour hybride") 299 ierr = NF_ENDDEF(nid) 300 call NF95_PUT_VAR(nid,nvarid,ap) 301 c 302 ierr = NF_REDEF (nid) 303 cIM 220306 BEG 304 #ifdef NC_DOUBLE 305 ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid) 306 #else 307 ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid) 308 #endif 309 cIM 220306 END 310 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26, 311 . "Coefficient B pour hybride") 312 ierr = NF_ENDDEF(nid) 313 call NF95_PUT_VAR(nid,nvarid,bp) 314 c 315 if (start_file_type.ne."earth") then 316 ierr = NF_REDEF (nid) 317 cIM 220306 BEG 318 #ifdef NC_DOUBLE 319 ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_s,nvarid) 320 #else 321 ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_s,nvarid) 322 #endif 323 cIM 220306 END 324 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 37, 325 . "Coef AS: hybrid pressure at midlayers") 326 ierr = NF_ENDDEF(nid) 327 call NF95_PUT_VAR(nid,nvarid,aps) 328 c 329 ierr = NF_REDEF (nid) 330 cIM 220306 BEG 331 #ifdef NC_DOUBLE 332 ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_s,nvarid) 333 #else 334 ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_s,nvarid) 335 #endif 336 cIM 220306 END 337 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 34, 338 . "Coef BS: hybrid sigma at midlayers") 339 ierr = NF_ENDDEF(nid) 340 call NF95_PUT_VAR(nid,nvarid,bps) 341 endif ! of if (start_file_type.ne."earth") 342 c 343 ierr = NF_REDEF (nid) 344 cIM 220306 BEG 345 #ifdef NC_DOUBLE 346 ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid) 347 #else 348 ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid) 349 #endif 350 cIM 220306 END 351 ierr = NF_ENDDEF(nid) 352 call NF95_PUT_VAR(nid,nvarid,presnivs) 353 c 354 if (start_file_type.ne."earth") then 75 !!! AS: idecal is a hack to be able to read planeto starts... 76 !!! .... while keeping everything OK for LMDZ EARTH 77 if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then 78 write(lunout,*) trim(modname),' : Planeto-like start file' 79 start_file_type="planeto" 80 idecal = 4 81 else 82 write(lunout,*) trim(modname),' : Earth-like start file' 83 idecal = 5 84 endif 85 86 tab_cntrl(:) = 0. 87 tab_cntrl(1) = REAL(iim) 88 tab_cntrl(2) = REAL(jjm) 89 tab_cntrl(3) = REAL(llm) 90 if (start_file_type.eq."earth") then 91 tab_cntrl(4)=REAL(day_ref) 92 else 93 !tab_cntrl(4)=REAL(day_end) 94 tab_cntrl(4)=REAL(iday_end) 95 endif 96 tab_cntrl(5) = REAL(annee_ref) 97 tab_cntrl(idecal+1) = rad 98 tab_cntrl(idecal+2) = omeg 99 tab_cntrl(idecal+3) = g 100 tab_cntrl(idecal+4) = cpp 101 tab_cntrl(idecal+5) = kappa 102 tab_cntrl(idecal+6) = daysec 103 tab_cntrl(idecal+7) = dtvr 104 tab_cntrl(idecal+8) = etot0 105 tab_cntrl(idecal+9) = ptot0 106 tab_cntrl(idecal+10) = ztot0 107 tab_cntrl(idecal+11) = stot0 108 tab_cntrl(idecal+12) = ang0 109 tab_cntrl(idecal+13) = pa 110 tab_cntrl(idecal+14) = preff 111 112 ! ..... parameters for the zoom ...... 113 tab_cntrl(idecal+15) = clon 114 tab_cntrl(idecal+16) = clat 115 tab_cntrl(idecal+17) = grossismx 116 tab_cntrl(idecal+18) = grossismy 117 ! 118 IF ( fxyhypb ) THEN 119 tab_cntrl(idecal+19) = 1. 120 tab_cntrl(idecal+20) = dzoomx 121 tab_cntrl(idecal+21) = dzoomy 122 tab_cntrl(idecal+22) = 0. 123 tab_cntrl(idecal+23) = taux 124 tab_cntrl(idecal+24) = tauy 125 ELSE 126 tab_cntrl(idecal+19) = 0. 127 tab_cntrl(idecal+20) = dzoomx 128 tab_cntrl(idecal+21) = dzoomy 129 tab_cntrl(idecal+22) = 0. 130 tab_cntrl(idecal+23) = 0. 131 tab_cntrl(idecal+24) = 0. 132 IF( ysinus ) tab_cntrl(idecal+22) = 1. 133 ENDIF 134 135 if (start_file_type.eq."earth") then 136 tab_cntrl(idecal+25) = REAL(iday_end) 137 tab_cntrl(idecal+26) = REAL(itau_dyn + itaufin) 138 ! start_time: start_time of simulation (not necessarily 0.) 139 tab_cntrl(idecal+27) = start_time 140 endif 141 142 if (planet_type=="mars") then ! For Mars only 143 tab_cntrl(29)=hour_ini 144 endif 145 146 !--- File creation 147 CALL err(NF90_CREATE(fichnom,NF90_CLOBBER,nid)) 148 149 !--- Some global attributes 150 CALL err(NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier demarrage dynamique")) 151 152 !--- Dimensions 153 if (start_file_type.eq."earth") then 154 CALL err(NF90_DEF_DIM(nid,"index", length, indexID)) 155 CALL err(NF90_DEF_DIM(nid,"rlonu", iip1, rlonuID)) 156 CALL err(NF90_DEF_DIM(nid,"rlatu", jjp1, rlatuID)) 157 CALL err(NF90_DEF_DIM(nid,"rlonv", iip1, rlonvID)) 158 CALL err(NF90_DEF_DIM(nid,"rlatv", jjm, rlatvID)) 159 CALL err(NF90_DEF_DIM(nid,"sigs", llm, sID)) 160 CALL err(NF90_DEF_DIM(nid,"sig", llmp1, sigID)) 161 CALL err(NF90_DEF_DIM(nid,"temps", NF90_UNLIMITED, timID)) 162 else 163 CALL err(NF90_DEF_DIM(nid,"index", length, indexID)) 164 CALL err(NF90_DEF_DIM(nid,"rlonu", iip1, rlonuID)) 165 CALL err(NF90_DEF_DIM(nid,"latitude", jjp1, rlatuID)) 166 CALL err(NF90_DEF_DIM(nid,"longitude", iip1, rlonvID)) 167 CALL err(NF90_DEF_DIM(nid,"rlatv", jjm, rlatvID)) 168 CALL err(NF90_DEF_DIM(nid,"altitude", llm, sID)) 169 CALL err(NF90_DEF_DIM(nid,"interlayer", llmp1, sigID)) 170 CALL err(NF90_DEF_DIM(nid,"Time", NF90_UNLIMITED, timID)) 171 endif 172 173 !--- Define and save invariant fields 174 CALL put_var1(nid,"controle","Parametres de controle" ,[indexID],tab_cntrl) 175 CALL put_var1(nid,"rlonu" ,"Longitudes des points U",[rlonuID],rlonu) 176 CALL put_var1(nid,"rlatu" ,"Latitudes des points U" ,[rlatuID],rlatu) 177 CALL put_var1(nid,"rlonv" ,"Longitudes des points V",[rlonvID],rlonv) 178 CALL put_var1(nid,"rlatv" ,"Latitudes des points V" ,[rlatvID],rlatv) 179 if (start_file_type.eq."earth") then 180 CALL put_var1(nid,"nivsigs" ,"Numero naturel des couches s" ,[sID] ,nivsigs) 181 CALL put_var1(nid,"nivsig" ,"Numero naturel des couches sigma",[sigID],nivsig) 182 endif ! of if (start_file_type.eq."earth") 183 CALL put_var1(nid,"ap" ,"Coefficient A pour hybride" ,[sigID],ap) 184 CALL put_var1(nid,"bp" ,"Coefficient B pour hybride" ,[sigID],bp) 185 if (start_file_type.ne."earth") then 186 CALL put_var1(nid,"aps","Coef AS: hybrid pressure at midlayers",[sID],aps) 187 CALL put_var1(nid,"bps","Coef BS: hybrid sigma at midlayers",[sID],bps) 188 endif ! of if (start_file_type.eq."earth") 189 CALL put_var1(nid,"presnivs","" ,[sID] ,presnivs) 190 if (start_file_type.ne."earth") then 355 191 ierr = NF_REDEF (nid) 356 192 #ifdef NC_DOUBLE 357 ierr = NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1, idim_rlatu,nvarid)193 ierr = NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1,rlatuID,vID) 358 194 #else 359 ierr = NF_DEF_VAR(nid,"latitude",NF_FLOAT,1, idim_rlatu,nvarid)195 ierr = NF_DEF_VAR(nid,"latitude",NF_FLOAT,1,rlatuID,vID) 360 196 #endif 361 ierr =NF_PUT_ATT_TEXT(nid, nvarid,'units',13,"degrees_north")362 ierr = NF_PUT_ATT_TEXT (nid, nvarid,"long_name", 14,363 ."North latitude")197 ierr =NF_PUT_ATT_TEXT(nid,vID,'units',13,"degrees_north") 198 ierr = NF_PUT_ATT_TEXT (nid,vID,"long_name", 14, & 199 "North latitude") 364 200 ierr = NF_ENDDEF(nid) 365 call NF95_PUT_VAR(nid, nvarid,rlatu*180/pi)366 c 201 call NF95_PUT_VAR(nid,vID,rlatu*180/pi) 202 ! 367 203 ierr = NF_REDEF (nid) 368 204 #ifdef NC_DOUBLE 369 ierr=NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1, idim_rlonv,nvarid)205 ierr=NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1,rlonvID,vID) 370 206 #else 371 ierr=NF_DEF_VAR(nid,"longitude",NF_FLOAT,1, idim_rlonv,nvarid)207 ierr=NF_DEF_VAR(nid,"longitude",NF_FLOAT,1,rlonvID,vID) 372 208 #endif 373 ierr = NF_PUT_ATT_TEXT (nid, nvarid,"long_name", 14,374 ."East longitude")375 ierr = NF_PUT_ATT_TEXT(nid, nvarid,'units',12,"degrees_east")209 ierr = NF_PUT_ATT_TEXT (nid,vID,"long_name", 14, & 210 "East longitude") 211 ierr = NF_PUT_ATT_TEXT(nid,vID,'units',12,"degrees_east") 376 212 ierr = NF_ENDDEF(nid) 377 call NF95_PUT_VAR(nid, nvarid,rlonv*180/pi)378 c 213 call NF95_PUT_VAR(nid,vID,rlonv*180/pi) 214 ! 379 215 ierr = NF_REDEF (nid) 380 216 #ifdef NC_DOUBLE 381 ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1, 382 . idim_s,nvarid)217 ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1, & 218 sID,vID) 383 219 #else 384 ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1, 385 . idim_s,nvarid)220 ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1, & 221 sID,vID) 386 222 #endif 387 ierr = NF_PUT_ATT_TEXT(nid, nvarid,"long_name",10,"pseudo-alt")388 ierr = NF_PUT_ATT_TEXT (nid, nvarid,'units',2,"km")389 ierr = NF_PUT_ATT_TEXT (nid, nvarid,'positive',2,"up")223 ierr = NF_PUT_ATT_TEXT(nid,vID,"long_name",10,"pseudo-alt") 224 ierr = NF_PUT_ATT_TEXT (nid,vID,'units',2,"km") 225 ierr = NF_PUT_ATT_TEXT (nid,vID,'positive',2,"up") 390 226 ierr = NF_ENDDEF(nid) 391 call NF95_PUT_VAR(nid,nvarid,pseudoalt) 392 endif ! of if (start_file_type.ne."earth") 393 c 394 c Coefficients de passage cov. <-> contra. <--> naturel 395 c 396 ierr = NF_REDEF (nid) 397 dims2(1) = idim_rlonu 398 dims2(2) = idim_rlatu 399 cIM 220306 BEG 400 #ifdef NC_DOUBLE 401 ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid) 402 #else 403 ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid) 404 #endif 405 cIM 220306 END 406 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29, 407 . "Coefficient de passage pour U") 408 ierr = NF_ENDDEF(nid) 409 call NF95_PUT_VAR(nid,nvarid,cu) 410 c 411 ierr = NF_REDEF (nid) 412 dims2(1) = idim_rlonv 413 dims2(2) = idim_rlatv 414 cIM 220306 BEG 415 #ifdef NC_DOUBLE 416 ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid) 417 #else 418 ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid) 419 #endif 420 cIM 220306 END 421 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29, 422 . "Coefficient de passage pour V") 423 ierr = NF_ENDDEF(nid) 424 call NF95_PUT_VAR(nid,nvarid,cv) 425 c 426 c Aire de chaque maille: 427 c 428 ierr = NF_REDEF (nid) 429 dims2(1) = idim_rlonv 430 dims2(2) = idim_rlatu 431 cIM 220306 BEG 432 #ifdef NC_DOUBLE 433 ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid) 434 #else 435 ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid) 436 #endif 437 cIM 220306 END 438 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, 439 . "Aires de chaque maille") 440 ierr = NF_ENDDEF(nid) 441 call NF95_PUT_VAR(nid,nvarid,aire) 442 c 443 c Geopentiel au sol: 444 c 445 ierr = NF_REDEF (nid) 446 dims2(1) = idim_rlonv 447 dims2(2) = idim_rlatu 448 cIM 220306 BEG 449 #ifdef NC_DOUBLE 450 ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid) 451 #else 452 ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid) 453 #endif 454 cIM 220306 END 455 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19, 456 . "Geopotentiel au sol") 457 ierr = NF_ENDDEF(nid) 458 call NF95_PUT_VAR(nid,nvarid,phis) 459 c 460 c Definir les variables pour pouvoir les enregistrer plus tard: 461 c 462 ierr = NF_REDEF (nid) ! entrer dans le mode de definition 463 c 464 if (start_file_type.eq."earth") then 465 cIM 220306 BEG 466 #ifdef NC_DOUBLE 467 ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid) 468 #else 469 ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid) 470 #endif 471 cIM 220306 END 472 else ! start_file_type=="planeto" 473 #ifdef NC_DOUBLE 474 ierr = NF_DEF_VAR (nid,"Time",NF_DOUBLE,1,idim_tim,nvarid) 475 #else 476 ierr = NF_DEF_VAR (nid,"Time",NF_FLOAT,1,idim_tim,nvarid) 477 #endif 478 endif ! of if (start_file_type.eq."earth") 479 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19, 480 . "Temps de simulation") 481 write(unites,200)yyears0,mmois0,jjour0 482 200 format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00') 483 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30, 484 . unites) 485 486 c 487 dims4(1) = idim_rlonu 488 dims4(2) = idim_rlatu 489 dims4(3) = idim_s 490 dims4(4) = idim_tim 491 cIM 220306 BEG 492 #ifdef NC_DOUBLE 493 ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid) 494 #else 495 ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid) 496 #endif 497 cIM 220306 END 498 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9, 499 . "Vitesse U") 500 c 501 dims4(1) = idim_rlonv 502 dims4(2) = idim_rlatv 503 dims4(3) = idim_s 504 dims4(4) = idim_tim 505 cIM 220306 BEG 506 #ifdef NC_DOUBLE 507 ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid) 508 #else 509 ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid) 510 #endif 511 cIM 220306 END 512 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9, 513 . "Vitesse V") 514 c 515 dims4(1) = idim_rlonv 516 dims4(2) = idim_rlatu 517 dims4(3) = idim_s 518 dims4(4) = idim_tim 519 cIM 220306 BEG 520 #ifdef NC_DOUBLE 521 ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid) 522 #else 523 ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid) 524 #endif 525 cIM 220306 END 526 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11, 527 . "Temperature") 528 c 529 dims4(1) = idim_rlonv 530 dims4(2) = idim_rlatu 531 dims4(3) = idim_s 532 dims4(4) = idim_tim 533 IF(nqtot.GE.1) THEN 534 DO iq=1,nqtot 535 cIM 220306 BEG 536 #ifdef NC_DOUBLE 537 ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid) 538 #else 539 ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid) 540 #endif 541 cIM 220306 END 542 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq)) 543 ENDDO 544 ENDIF 545 c 546 dims4(1) = idim_rlonv 547 dims4(2) = idim_rlatu 548 dims4(3) = idim_s 549 dims4(4) = idim_tim 550 cIM 220306 BEG 551 #ifdef NC_DOUBLE 552 ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid) 553 #else 554 ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid) 555 #endif 556 cIM 220306 END 557 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12, 558 . "C est quoi ?") 559 c 560 dims3(1) = idim_rlonv 561 dims3(2) = idim_rlatu 562 dims3(3) = idim_tim 563 cIM 220306 BEG 564 #ifdef NC_DOUBLE 565 ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid) 566 #else 567 ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid) 568 #endif 569 cIM 220306 END 570 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15, 571 . "Pression au sol") 572 c 573 ierr = NF_ENDDEF(nid) ! sortir du mode de definition 574 ierr = NF_CLOSE(nid) ! fermer le fichier 575 576 write(lunout,*)'dynredem0: iim,jjm,llm,iday_end', 577 & iim,jjm,llm,iday_end 578 write(lunout,*)'dynredem0: rad,omeg,g,cpp,kappa', 579 & rad,omeg,g,cpp,kappa 580 581 RETURN 582 END 227 call NF95_PUT_VAR(nid,vID,pseudoalt) 228 CALL err(NF_REDEF(nid)) 229 endif ! of if (start_file_type.ne."earth") 230 231 ! covariant <-> contravariant <-> natural conversion coefficients 232 CALL put_var2(nid,"cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu) 233 CALL put_var2(nid,"cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv) 234 CALL put_var2(nid,"aire","Aires de chaque maille" ,[rlonvID,rlatuID],aire) 235 CALL put_var2(nid,"phisinit","Geopotentiel au sol" ,[rlonvID,rlatuID],phis) 236 237 238 ! Define variables that will be stored later: 239 WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')"),& 240 yyears0,mmois0,jjour0 241 IF (planet_type.eq."earth") THEN 242 CALL cre_var(nid,"temps","Temps de simulation",[timID],unites) 243 ELSE 244 CALL cre_var(nid,"Time","Temps de simulation",[timID],unites) 245 ENDIF 246 247 CALL cre_var(nid,"ucov" ,"Vitesse U" ,[rlonuID,rlatuID,sID,timID]) 248 CALL cre_var(nid,"vcov" ,"Vitesse V" ,[rlonvID,rlatvID,sID,timID]) 249 CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID]) 250 251 IF(nqtot.GE.1) THEN 252 DO iq=1,nqtot 253 CALL cre_var(nid,tname(iq),ttext(iq),[rlonvID,rlatuID,sID,timID]) 254 END DO 255 ENDIF 256 257 CALL cre_var(nid,"masse","Masse d air" ,[rlonvID,rlatuID,sID,timID]) 258 CALL cre_var(nid,"ps" ,"Pression au sol",[rlonvID,rlatuID ,timID]) 259 260 CALL err(NF90_CLOSE (nid)) ! close file 261 262 WRITE(lunout,*)TRIM(modname)//': iim,jjm,llm,iday_end',iim,jjm,llm,iday_end 263 WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa 264 265 END SUBROUTINE dynredem0 583 266 584 267 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 585 268 586 SUBROUTINE dynredem1(fichnom,time, 587 . vcov,ucov,teta,q,masse,ps) 588 USE infotrac 589 USE control_mod, only : planet_type 590 use netcdf, only: NF90_get_VAR 591 use netcdf95, only: NF95_PUT_VAR 592 USE temps_mod, ONLY: itaufin,itau_dyn 269 SUBROUTINE dynredem1(fichnom,time,vcov,ucov,teta,q,masse,ps) 270 ! 271 !------------------------------------------------------------------------------- 272 ! Purpose: Write the NetCDF restart file (append). 273 !------------------------------------------------------------------------------- 274 USE infotrac, ONLY: nqtot, tname, type_trac 275 USE control_mod, only : planet_type 276 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID, & 277 NF90_CLOSE, NF90_WRITE, NF90_PUT_VAR, NF90_NoErr 278 use netcdf95, only: NF95_PUT_VAR 279 USE temps_mod, ONLY: itaufin,itau_dyn 280 USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, & 281 err, modname, fil, msg 593 282 594 IMPLICIT NONE 595 c================================================================= 596 c Ecriture du fichier de redemarrage sous format NetCDF 597 c================================================================= 598 #include "dimensions.h" 599 #include "paramet.h" 600 #include "netcdf.inc" 601 #include "comgeom.h" 602 #include "iniprint.h" 603 604 605 INTEGER l 606 REAL vcov(iip1,jjm,llm),ucov(iip1, jjp1,llm) 607 REAL teta(iip1, jjp1,llm) 608 REAL ps(iip1, jjp1),masse(iip1, jjp1,llm) 609 REAL q(iip1, jjp1, llm, nqtot) 610 CHARACTER*(*) fichnom 611 612 REAL time 613 INTEGER nid, nvarid, nid_trac, nvarid_trac 614 REAL trac_tmp(ip1jmp1,llm) 615 INTEGER ierr, ierr_file 616 INTEGER iq 617 INTEGER length 618 PARAMETER (length = 100) 619 REAL tab_cntrl(length) ! tableau des parametres du run 620 character(len=*),parameter :: modname='dynredem1' 621 character*80 abort_message 622 c 623 INTEGER nb 624 SAVE nb 625 DATA nb / 0 / 626 character(len=12) :: start_file_type="earth" ! default start file type 627 628 if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then 629 write(lunout,*) trim(modname),' : Planeto-like start file' 630 start_file_type="planeto" 631 else 632 write(lunout,*) trim(modname),' : Earth-like start file' 633 endif 634 635 ierr = NF_OPEN(fichnom, NF_WRITE, nid) 636 IF (ierr .NE. NF_NOERR) THEN 637 PRINT*, "dynredem1: Pb. d ouverture "//trim(fichnom) 638 CALL abort_gcm("dynredem1", "", 1) 639 ENDIF 640 641 c Ecriture/extension de la coordonnee temps 642 643 nb = nb + 1 644 if (start_file_type.eq."earth") then 645 ierr = NF_INQ_VARID(nid, "temps", nvarid) 283 IMPLICIT NONE 284 include "dimensions.h" 285 include "paramet.h" 286 include "netcdf.inc" 287 include "comgeom.h" 288 include "iniprint.h" 289 !=============================================================================== 290 ! Arguments: 291 CHARACTER(LEN=*), INTENT(IN) :: fichnom !-- FILE NAME 292 REAL, INTENT(IN) :: time !-- TIME 293 REAL, INTENT(IN) :: vcov(iip1,jjm, llm) !-- V COVARIANT WIND 294 REAL, INTENT(IN) :: ucov(iip1,jjp1,llm) !-- U COVARIANT WIND 295 REAL, INTENT(IN) :: teta(iip1,jjp1,llm) !-- POTENTIAL TEMPERATURE 296 REAL, INTENT(INOUT) :: q(iip1,jjp1,llm,nqtot) !-- TRACERS 297 REAL, INTENT(IN) :: masse(iip1,jjp1,llm) !-- MASS PER CELL 298 REAL, INTENT(IN) :: ps(iip1,jjp1) !-- GROUND PRESSURE 299 !=============================================================================== 300 ! Local variables: 301 INTEGER :: l, iq, nid, vID, ierr, nid_trac, vID_trac 302 INTEGER,SAVE :: nb=0 303 INTEGER, PARAMETER :: length=100 304 REAL :: tab_cntrl(length) ! tableau des parametres du run 305 CHARACTER(LEN=256) :: var, dum 306 LOGICAL :: lread_inca 307 CHARACTER(LEN=80) :: abort_message 308 CHARACTER(len=12) :: start_file_type="earth" ! default start file type 309 310 ! fill dynredem_mod module variables 311 modname='dynredem1'; fil=fichnom 312 313 if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then 314 write(lunout,*) trim(modname),' : Planeto-like start file' 315 start_file_type="planeto" 316 else 317 write(lunout,*) trim(modname),' : Earth-like start file' 318 endif 319 320 CALL err(NF90_OPEN(fil,NF90_WRITE,nid),"open",fil) 321 322 !--- Write/extend time coordinate 323 nb = nb + 1 324 if (start_file_type.eq."earth") then 325 ierr = NF_INQ_VARID(nid, "temps", vID) 646 326 IF (ierr .NE. NF_NOERR) THEN 647 327 write(lunout,*) NF_STRERROR(ierr) … … 649 329 CALL abort_gcm(modname,abort_message,ierr) 650 330 ENDIF 651 652 ierr = NF_INQ_VARID(nid,"Time", nvarid)331 else 332 ierr = NF_INQ_VARID(nid,"Time", vID) 653 333 IF (ierr .NE. NF_NOERR) THEN 654 334 write(lunout,*) NF_STRERROR(ierr) … … 656 336 CALL abort_gcm(modname,abort_message,ierr) 657 337 ENDIF 658 endif ! of if (start_file_type.eq."earth") 659 call NF95_PUT_VAR(nid,nvarid,time,start=(/nb/)) 660 write(lunout,*) "dynredem1: Enregistrement pour ", nb, time 661 662 c 663 c Re-ecriture du tableau de controle, itaufin n'est plus defini quand 664 c on passe dans dynredem0 665 ierr = NF_INQ_VARID (nid, "controle", nvarid) 666 IF (ierr .NE. NF_NOERR) THEN 667 abort_message="dynredem1: Le champ <controle> est absent" 668 ierr = 1 669 CALL abort_gcm(modname,abort_message,ierr) 670 ENDIF 671 ierr = NF90_GET_VAR(nid, nvarid, tab_cntrl) 672 if (start_file_type=="earth") then 673 tab_cntrl(31) = REAL(itau_dyn + itaufin) 674 else 675 tab_cntrl(31) = 0 676 endif 677 call NF95_PUT_VAR(nid,nvarid,tab_cntrl) 678 679 c Ecriture des champs 680 c 681 ierr = NF_INQ_VARID(nid, "ucov", nvarid) 682 IF (ierr .NE. NF_NOERR) THEN 683 abort_message="Variable ucov n est pas definie" 684 ierr=1 685 CALL abort_gcm(modname,abort_message,ierr) 686 ENDIF 687 call NF95_PUT_VAR(nid,nvarid,ucov,start=(/1,1,1,nb/)) 688 689 ierr = NF_INQ_VARID(nid, "vcov", nvarid) 690 IF (ierr .NE. NF_NOERR) THEN 691 abort_message="Variable vcov n est pas definie" 692 ierr=1 693 CALL abort_gcm(modname,abort_message,ierr) 694 ENDIF 695 call NF95_PUT_VAR(nid,nvarid,vcov,start=(/1,1,1,nb/)) 696 697 ierr = NF_INQ_VARID(nid, "teta", nvarid) 698 IF (ierr .NE. NF_NOERR) THEN 699 abort_message="Variable teta n est pas definie" 700 ierr=1 701 CALL abort_gcm(modname,abort_message,ierr) 702 ENDIF 703 call NF95_PUT_VAR(nid,nvarid,teta,start=(/1,1,1,nb/)) 704 705 IF (type_trac == 'inca') THEN 706 ! Ajout Anne pour lecture valeurs traceurs dans un fichier start_trac.nc 707 ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac) 708 IF (ierr_file .NE.NF_NOERR) THEN 709 write(lunout,*)'dynredem1: Pb d''ouverture du fichier', 710 & ' start_trac.nc' 711 write(lunout,*)' ierr = ', ierr_file 712 ENDIF 713 END IF 714 715 IF(nqtot.GE.1) THEN 716 do iq=1,nqtot 717 718 IF (type_trac /= 'inca') THEN 719 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) 720 IF (ierr .NE. NF_NOERR) THEN 721 abort_message="Variable tname(iq) n est pas definie" 722 ierr=1 723 CALL abort_gcm(modname,abort_message,ierr) 724 ENDIF 725 call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq),start=(/1,1,1,nb/)) 726 ELSE ! type_trac = inca 727 ! lecture de la valeur du traceur dans start_trac.nc 728 IF (ierr_file .ne. 2) THEN 729 ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac) 730 IF (ierr .NE. NF_NOERR) THEN 731 write(lunout,*) "dynredem1: ",trim(tname(iq)), 732 & " est absent de start_trac.nc" 733 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) 734 IF (ierr .NE. NF_NOERR) THEN 735 abort_message="dynredem1: Variable "// 736 & trim(tname(iq))//" n est pas definie" 737 ierr=1 738 CALL abort_gcm(modname,abort_message,ierr) 739 ENDIF 740 call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq)) 741 742 ELSE 743 write(lunout,*) "dynredem1: ",trim(tname(iq)), 744 & " est present dans start_trac.nc" 745 ierr = NF90_GET_VAR(nid_trac, nvarid_trac, trac_tmp) 746 IF (ierr .NE. NF_NOERR) THEN 747 abort_message="dynredem1: Lecture echouee pour"// 748 & trim(tname(iq)) 749 ierr=1 750 CALL abort_gcm(modname,abort_message,ierr) 751 ENDIF 752 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) 753 IF (ierr .NE. NF_NOERR) THEN 754 abort_message="dynredem1: Variable "// 755 & trim(tname(iq))//" n est pas definie" 756 ierr=1 757 CALL abort_gcm(modname,abort_message,ierr) 758 ENDIF 759 call NF95_PUT_VAR(nid, nvarid, trac_tmp) 760 761 ENDIF ! IF (ierr .NE. NF_NOERR) 762 ! fin lecture du traceur 763 ELSE ! si il n'y a pas de fichier start_trac.nc 764 ! print *, 'il n y a pas de fichier start_trac' 765 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) 766 IF (ierr .NE. NF_NOERR) THEN 767 abort_message="dynredem1: Variable "// 768 & trim(tname(iq))//" n est pas definie" 769 ierr=1 770 CALL abort_gcm(modname,abort_message,ierr) 771 ENDIF 772 call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq), 773 & start=(/1,1,1,nb/)) 774 ENDIF ! (ierr_file .ne. 2) 775 END IF !type_trac 776 777 ENDDO 778 ENDIF 779 c 780 ierr = NF_INQ_VARID(nid, "masse", nvarid) 781 IF (ierr .NE. NF_NOERR) THEN 782 abort_message="dynredem1: Variable masse n est pas definie" 783 ierr=1 784 CALL abort_gcm(modname,abort_message,ierr) 785 ENDIF 786 call NF95_PUT_VAR(nid,nvarid,masse,start=(/1,1,1,nb/)) 787 c 788 ierr = NF_INQ_VARID(nid, "ps", nvarid) 789 IF (ierr .NE. NF_NOERR) THEN 790 abort_message="dynredem1: Variable ps n est pas definie" 791 ierr=1 792 CALL abort_gcm(modname,abort_message,ierr) 793 ENDIF 794 call NF95_PUT_VAR(nid,nvarid,ps,start=(/1,1,nb/)) 795 796 ierr = NF_CLOSE(nid) 797 c 798 RETURN 799 END 800 338 endif ! of if (start_file_type.eq."earth") 339 call NF95_PUT_VAR(nid,vID,time,start=(/nb/)) 340 WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time 341 342 !--- Rewrite control table (itaufin undefined in dynredem0) 343 var="controle" 344 CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var) 345 CALL err(NF90_GET_VAR(nid,vID,tab_cntrl),"get",var) 346 if (start_file_type=="earth") then 347 tab_cntrl(31) = REAL(itau_dyn + itaufin) 348 else 349 tab_cntrl(31) = 0 350 endif 351 CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var) 352 CALL err(NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var) 353 354 !--- Save fields 355 CALL dynredem_write_u(nid,"ucov" ,ucov ,llm, nb) 356 CALL dynredem_write_v(nid,"vcov" ,vcov ,llm, nb) 357 CALL dynredem_write_u(nid,"teta" ,teta ,llm, nb) 358 CALL dynredem_write_u(nid,"masse",masse,llm, nb) 359 CALL dynredem_write_u(nid,"ps" ,ps ,1, nb) 360 361 !--- Tracers in file "start_trac.nc" (added by Anne) 362 lread_inca=.FALSE.; fil="start_trac.nc" 363 IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca) 364 IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open") 365 366 !--- Save tracers 367 IF(nqtot.GE.1) THEN 368 DO iq=1,nqtot 369 var=tname(iq); ierr=-1 370 IF(lread_inca) THEN !--- Possibly read from "start_trac.nc" 371 fil="start_trac.nc" 372 ierr=NF90_INQ_VARID(nid_trac,var,vID_trac) 373 dum='inq'; IF(ierr==NF90_NoErr) dum='fnd' 374 WRITE(lunout,*)msg(dum,var) 375 376 377 IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,:,iq),llm) 378 END IF ! of IF(lread_inca) 379 fil=fichnom 380 CALL dynredem_write_u(nid,var,q(:,:,:,iq),llm,nb) 381 END DO ! of DO iq=1,nqtot 382 ENDIF ! of IF(nqtot.GE.1) 383 384 CALL err(NF90_CLOSE(nid),"close") 385 fil="start_trac.nc" 386 IF(lread_inca) CALL err(NF90_CLOSE(nid_trac),"close") 387 388 END SUBROUTINE dynredem1 389 -
trunk/LMDZ.COMMON/libf/dyn3d_common/infotrac.F90
r1403 r1508 12 12 INTEGER, SAVE :: nbtr 13 13 14 ! CRisi: nb of father tracers (i.e. directly advected by air) 15 INTEGER, SAVE :: nqperes 16 14 17 ! Name variables 15 18 CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics … … 22 25 ! dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code. 23 26 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: niadv ! equivalent dyn / physique 27 28 ! CRisi: arrays for sons 29 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nqfils 30 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nqdesc ! number of sons + all gran-sons over all generations 31 INTEGER, SAVE :: nqdesc_tot 32 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqfils 33 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iqpere 24 34 25 35 ! conv_flg(it)=0 : convection desactivated for tracer number it … … 30 40 CHARACTER(len=4),SAVE :: type_trac 31 41 CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym 32 42 43 ! CRisi: specific stuff for isotopes 44 LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso 45 INTEGER :: niso_possibles 46 PARAMETER ( niso_possibles=5) ! 5 possible water isotopes 47 real, DIMENSION (niso_possibles),SAVE :: tnat,alpha_ideal 48 LOGICAL, DIMENSION(niso_possibles),SAVE :: use_iso 49 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqiso ! donne indice iq en fn de (ixt,phase) 50 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot 51 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot 52 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: zone_num ! donne numéro de la zone de tracage en fn de nqtot 53 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: phase_num ! donne numéro de la zone de tracage en fn de nqtot 54 INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles 55 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: index_trac ! numéro ixt en fn izone, indnum entre 1 et niso 56 INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso 57 33 58 CONTAINS 34 59 35 60 SUBROUTINE infotrac_init 36 USE control_mod 61 USE control_mod, ONLY: planet_type, config_inca 37 62 #ifdef REPROBUS 38 63 USE CHEM_REP, ONLY : Init_chem_rep_trac … … 63 88 64 89 CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0 ! tracer short name 90 CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_transp ! transporting fluid short name: CRisi 65 91 CHARACTER(len=3), DIMENSION(30) :: descrq 66 92 CHARACTER(len=1), DIMENSION(3) :: txts … … 70 96 INTEGER :: nqtrue ! number of tracers read from tracer.def, without higer order of moment 71 97 INTEGER :: iq, new_iq, iiq, jq, ierr, ierr2, ierr3 98 INTEGER :: ifils,ipere,generation ! CRisi 99 LOGICAL :: continu,nouveau_traceurdef 100 INTEGER :: IOstatus ! gestion de la retrocompatibilite de traceur.def 101 CHARACTER(len=15) :: tchaine 72 102 73 103 character(len=80) :: line ! to store a line of text … … 138 168 WRITE(lunout,*) trim(modname),': Open traceur.def : ok' 139 169 READ(90,*) nqtrue 170 WRITE(lunout,*) trim(modname),' nqtrue=',nqtrue 140 171 ELSE 141 172 WRITE(lunout,*) trim(modname),': Problem in opening traceur.def' … … 146 177 nbtr=nqtrue-2 147 178 ELSE ! type_trac=inca 148 ! nbtr has been read from INCA by init_cont_lmdz() in gcm.F 149 nqtrue=nbtr+2 150 END IF 179 ! The traceur.def file is used to define the number "nqo" of water phases 180 ! present in the simulation. Default : nqo = 2. 181 OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr) 182 IF(ierr.EQ.0) THEN 183 WRITE(lunout,*) trim(modname),': Open traceur.def : ok' 184 READ(90,*) nqo 185 ELSE 186 WRITE(lunout,*) trim(modname),': Using default value for nqo' 187 nqo=2 188 ENDIF 189 IF (nqo /= 2 .AND. nqo /= 3 ) THEN 190 WRITE(lunout,*) trim(modname),': nqo=',nqo, ' is not allowded. Only 2 or 3 water phases allowed' 191 CALL abort_gcm('infotrac_init','Bad number of water phases',1) 192 END IF 193 ! nbtr has been read from INCA by init_const_lmdz() in gcm.F 194 #ifdef INCA 195 CALL Init_chem_inca_trac(nbtr) 196 #endif 197 nqtrue=nbtr+nqo 198 END IF ! type_trac 151 199 152 200 IF (nqtrue < 2) THEN … … 155 203 END IF 156 204 205 !jyg< 157 206 ! Transfert number of tracers to Reprobus 158 IF (type_trac == 'repr') THEN 159 #ifdef REPROBUS 160 CALL Init_chem_rep_trac(nbtr) 161 #endif 162 END IF 207 !! IF (type_trac == 'repr') THEN 208 !!#ifdef REPROBUS 209 !! CALL Init_chem_rep_trac(nbtr) 210 !!#endif 211 !! END IF 212 !>jyg 163 213 164 214 ELSE ! not Earth … … 175 225 ! in the dynamics than in the physics 176 226 nbtr=nqtrue 227 nqo=0 177 228 178 229 ENDIF ! planet_type … … 180 231 ! Allocate variables depending on nqtrue and nbtr 181 232 ! 182 ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue)) 183 ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr)) 184 conv_flg(:) = 1 ! convection activated for all tracers 185 pbl_flg(:) = 1 ! boundary layer activated for all tracers 233 ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue),tnom_transp(nqtrue)) 234 ! 235 !jyg< 236 !! ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr)) 237 !! conv_flg(:) = 1 ! convection activated for all tracers 238 !! pbl_flg(:) = 1 ! boundary layer activated for all tracers 239 !>jyg 186 240 187 241 !----------------------------------------------------------------------- … … 216 270 ! Continue to read tracer.def 217 271 DO iq=1,nqtrue 218 READ(90,*) hadv(iq),vadv(iq),tnom_0(iq) 219 END DO 272 273 write(*,*) 'infotrac 237: iq=',iq 274 ! CRisi: ajout du nom du fluide transporteur 275 ! mais rester retro compatible 276 READ(90,'(I2,X,I2,X,A)',IOSTAT=IOstatus) hadv(iq),vadv(iq),tchaine 277 write(lunout,*) 'iq,hadv(iq),vadv(iq)=',iq,hadv(iq),vadv(iq) 278 write(lunout,*) 'tchaine=',trim(tchaine) 279 ! write(*,*) 'infotrac 238: IOstatus=',IOstatus 280 if (IOstatus.ne.0) then 281 CALL abort_gcm('infotrac_init','Pb dans la lecture de traceur.def',1) 282 endif 283 ! Y-a-t-il 1 ou 2 noms de traceurs? -> On regarde s'il y a un 284 ! espace ou pas au milieu de la chaine. 285 continu=.true. 286 nouveau_traceurdef=.false. 287 iiq=1 288 do while (continu) 289 if (tchaine(iiq:iiq).eq.' ') then 290 nouveau_traceurdef=.true. 291 continu=.false. 292 else if (iiq.lt.LEN_TRIM(tchaine)) then 293 iiq=iiq+1 294 else 295 continu=.false. 296 endif 297 enddo 298 write(*,*) 'iiq,nouveau_traceurdef=',iiq,nouveau_traceurdef 299 if (nouveau_traceurdef) then 300 write(lunout,*) 'C''est la nouvelle version de traceur.def' 301 tnom_0(iq)=tchaine(1:iiq-1) 302 tnom_transp(iq)=tchaine(iiq+1:15) 303 else 304 write(lunout,*) 'C''est l''ancienne version de traceur.def' 305 write(lunout,*) 'On suppose que les traceurs sont tous d''air' 306 tnom_0(iq)=tchaine 307 tnom_transp(iq) = 'air' 308 endif 309 write(lunout,*) 'tnom_0(iq)=<',trim(tnom_0(iq)),'>' 310 write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>' 311 312 END DO ! DO iq=1,nqtrue 220 313 CLOSE(90) 314 221 315 ELSE ! Without tracer.def, set default values (for Earth!) 222 316 if ((nqtrue==4).and.(planet_type=="earth")) then … … 224 318 vadv(1) = 14 225 319 tnom_0(1) = 'H2Ov' 320 tnom_transp(1) = 'air' 226 321 hadv(2) = 10 227 322 vadv(2) = 10 228 323 tnom_0(2) = 'H2Ol' 324 tnom_transp(2) = 'air' 229 325 hadv(3) = 10 230 326 vadv(3) = 10 231 327 tnom_0(3) = 'RN' 328 tnom_transp(3) = 'air' 232 329 hadv(4) = 10 233 330 vadv(4) = 10 234 331 tnom_0(4) = 'PB' 332 tnom_transp(4) = 'air' 235 333 else 236 334 ! Error message, we need a traceur.def file … … 240 338 CALL abort_gcm('infotrac_init','Need a traceur.def file!',1) 241 339 endif ! of if (nqtrue==4) 242 END IF 340 END IF ! of IF(ierr.EQ.0) 243 341 244 !CR: nombre de traceurs de l eau245 if (tnom_0(3) == 'H2Oi') then246 nqo=3247 else248 nqo=2249 endif250 251 342 WRITE(lunout,*) trim(modname),': Valeur de traceur.def :' 252 343 WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue 253 344 DO iq=1,nqtrue 254 WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq) 345 WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq),tnom_transp(iq) 255 346 END DO 256 347 257 ELSE ! type_trac=inca : config_inca='aero' ou 'chem' 348 !CR: nombre de traceurs de l eau 349 if (tnom_0(3) == 'H2Oi') then 350 nqo=3 351 else 352 nqo=2 353 endif 354 ! For Earth, water vapour & liquid tracers are not in the physics 355 nbtr=nqtrue-nqo 356 ENDIF ! (type_trac == 'lmdz' .OR. type_trac == 'repr') 357 !jyg< 358 ! 359 ! Transfert number of tracers to Reprobus 360 IF (type_trac == 'repr') THEN 361 #ifdef REPROBUS 362 CALL Init_chem_rep_trac(nbtr) 363 #endif 364 END IF 365 ! 366 ! Allocate variables depending on nbtr 367 ! 368 ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr)) 369 conv_flg(:) = 1 ! convection activated for all tracers 370 pbl_flg(:) = 1 ! boundary layer activated for all tracers 371 ! 372 !! ELSE ! type_trac=inca : config_inca='aero' ou 'chem' 373 ! 374 IF (type_trac == 'inca') THEN ! config_inca='aero' ou 'chem' 375 !>jyg 258 376 ! le module de chimie fournit les noms des traceurs 259 377 ! et les schemas d'advection associes. … … 268 386 #endif 269 387 tnom_0(1)='H2Ov' 388 tnom_transp(1) = 'air' 270 389 tnom_0(2)='H2Ol' 271 272 DO iq =3,nqtrue 273 tnom_0(iq)=solsym(iq-2) 390 tnom_transp(2) = 'air' 391 IF (nqo == 3) then 392 tnom_0(3)='H2Oi' !! jyg 393 tnom_transp(3) = 'air' 394 endif 395 396 !jyg< 397 DO iq = nqo+1, nqtrue 398 tnom_0(iq)=solsym(iq-nqo) 399 tnom_transp(iq) = 'air' 274 400 END DO 275 nqo = 2 276 277 END IF ! type_trac 401 !! DO iq =3,nqtrue 402 !! tnom_0(iq)=solsym(iq-2) 403 !! END DO 404 !! nqo = 2 405 !>jyg 406 407 END IF ! (type_trac == 'inca') 278 408 279 409 ELSE ! not Earth 410 ! Other planets (for now); we have the same number of tracers 411 ! in the dynamics than in the physics 412 nbtr=nqtrue 413 ! NB: Reading a traceur.def with isotopes remains to be done... 280 414 IF(ierr.EQ.0) THEN 281 415 ! Continue to read tracer.def … … 296 430 endif 297 431 endif ! of if(ierr2.ne.0) 432 tnom_transp(iq)='air' ! no isotopes... for now... 298 433 END DO ! of DO iq=1,nqtrue 299 434 CLOSE(90) … … 302 437 vadv(1) = 10 303 438 tnom_0(1) = 'dummy' 439 tnom_transp(1)='air' 304 440 END IF 305 441 … … 307 443 WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue 308 444 DO iq=1,nqtrue 309 WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq) 445 WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq),tnom_transp(iq) 310 446 END DO 311 447 … … 437 573 438 574 !----------------------------------------------------------------------- 575 ! 576 ! 5) Determine father/son relations for isotopes and carrying fluid 577 ! 578 !----------------------------------------------------------------------- 579 580 ! CRisi: quels sont les traceurs fils et les traceurs pères. 581 ! initialiser tous les tableaux d'indices liés aux traceurs familiaux 582 ! + vérifier que tous les pères sont écrits en premières positions 583 ALLOCATE(nqfils(nqtot),nqdesc(nqtot)) 584 ALLOCATE(iqfils(nqtot,nqtot)) 585 ALLOCATE(iqpere(nqtot)) 586 nqperes=0 587 nqfils(:)=0 588 nqdesc(:)=0 589 iqfils(:,:)=0 590 iqpere(:)=0 591 nqdesc_tot=0 592 DO iq=1,nqtot 593 if (tnom_transp(iq) == 'air') then 594 ! ceci est un traceur père 595 WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un pere' 596 nqperes=nqperes+1 597 iqpere(iq)=0 598 else !if (tnom_transp(iq) == 'air') then 599 ! ceci est un fils. Qui est son père? 600 WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un fils' 601 continu=.true. 602 ipere=1 603 do while (continu) 604 if (tnom_transp(iq) == tnom_0(ipere)) then 605 ! Son père est ipere 606 WRITE(lunout,*) 'Le traceur',iq,'appele ', & 607 & trim(tnom_0(iq)),' est le fils de ',ipere,'appele ',trim(tnom_0(ipere)) 608 nqfils(ipere)=nqfils(ipere)+1 609 iqfils(nqfils(ipere),ipere)=iq 610 iqpere(iq)=ipere 611 continu=.false. 612 else !if (tnom_transp(iq) == tnom_0(ipere)) then 613 ipere=ipere+1 614 if (ipere.gt.nqtot) then 615 WRITE(lunout,*) 'Le traceur',iq,'appele ', & 616 & trim(tnom_0(iq)),', est orpelin.' 617 CALL abort_gcm('infotrac_init','Un traceur est orphelin',1) 618 endif !if (ipere.gt.nqtot) then 619 endif !if (tnom_transp(iq) == tnom_0(ipere)) then 620 enddo !do while (continu) 621 endif !if (tnom_transp(iq) == 'air') then 622 enddo !DO iq=1,nqtot 623 WRITE(lunout,*) 'infotrac: nqperes=',nqperes 624 WRITE(lunout,*) 'nqfils=',nqfils 625 WRITE(lunout,*) 'iqpere=',iqpere 626 WRITE(lunout,*) 'iqfils=',iqfils 627 628 ! Calculer le nombre de descendants à partir de iqfils et de nbfils 629 DO iq=1,nqtot 630 generation=0 631 continu=.true. 632 ifils=iq 633 do while (continu) 634 ipere=iqpere(ifils) 635 if (ipere.gt.0) then 636 nqdesc(ipere)=nqdesc(ipere)+1 637 nqdesc_tot=nqdesc_tot+1 638 iqfils(nqdesc(ipere),ipere)=iq 639 ifils=ipere 640 generation=generation+1 641 else !if (ipere.gt.0) then 642 continu=.false. 643 endif !if (ipere.gt.0) then 644 enddo !do while (continu) 645 WRITE(lunout,*) 'Le traceur ',iq,', appele ',trim(tnom_0(iq)),' est un traceur de generation: ',generation 646 enddo !DO iq=1,nqtot 647 WRITE(lunout,*) 'infotrac: nqdesc=',nqdesc 648 WRITE(lunout,*) 'iqfils=',iqfils 649 WRITE(lunout,*) 'nqdesc_tot=',nqdesc_tot 650 651 ! Interdire autres schémas que 10 pour les traceurs fils, et autres schémas 652 ! que 10 et 14 si des pères ont des fils 653 do iq=1,nqtot 654 if (iqpere(iq).gt.0) then 655 ! ce traceur a un père qui n'est pas l'air 656 ! Seul le schéma 10 est autorisé 657 if (iadv(iq)/=10) then 658 WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for sons' 659 CALL abort_gcm('infotrac_init','Sons should be advected by scheme 10',1) 660 endif 661 ! Le traceur père ne peut être advecté que par schéma 10 ou 14: 662 IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN 663 WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for fathers' 664 CALL abort_gcm('infotrac_init','Fathers should be advected by scheme 10 ou 14',1) 665 endif !IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN 666 endif !if (iqpere(iq).gt.0) the 667 enddo !do iq=1,nqtot 668 669 670 ! detecter quels sont les traceurs isotopiques parmi des traceurs 671 call infotrac_isoinit(tnom_0,nqtrue) 672 673 !----------------------------------------------------------------------- 439 674 ! Finalize : 440 675 ! 441 DEALLOCATE(tnom_0, hadv, vadv )676 DEALLOCATE(tnom_0, hadv, vadv,tnom_transp) 442 677 443 678 444 679 END SUBROUTINE infotrac_init 680 681 !----------------------------------------------------------------------- 682 683 SUBROUTINE infotrac_isoinit(tnom_0,nqtrue) 684 685 #ifdef CPP_IOIPSL 686 use IOIPSL 687 #else 688 ! if not using IOIPSL, we still need to use (a local version of) getin 689 use ioipsl_getincom 690 #endif 691 implicit none 692 693 ! inputs 694 INTEGER nqtrue 695 CHARACTER(len=15) tnom_0(nqtrue) 696 697 ! locals 698 CHARACTER(len=3), DIMENSION(niso_possibles) :: tnom_iso 699 INTEGER, ALLOCATABLE,DIMENSION(:,:) :: nb_iso,nb_traciso 700 INTEGER, ALLOCATABLE,DIMENSION(:) :: nb_isoind 701 INTEGER :: ntraceurs_zone_prec,iq,phase,ixt,iiso,izone 702 CHARACTER(len=19) :: tnom_trac 703 INCLUDE "iniprint.h" 704 705 tnom_iso=(/'eau','HDO','O18','O17','HTO'/) 706 707 ALLOCATE(nb_iso(niso_possibles,nqo)) 708 ALLOCATE(nb_isoind(nqo)) 709 ALLOCATE(nb_traciso(niso_possibles,nqo)) 710 ALLOCATE(iso_num(nqtot)) 711 ALLOCATE(iso_indnum(nqtot)) 712 ALLOCATE(zone_num(nqtot)) 713 ALLOCATE(phase_num(nqtot)) 714 715 iso_num(:)=0 716 iso_indnum(:)=0 717 zone_num(:)=0 718 phase_num(:)=0 719 indnum_fn_num(:)=0 720 use_iso(:)=.false. 721 nb_iso(:,:)=0 722 nb_isoind(:)=0 723 nb_traciso(:,:)=0 724 niso=0 725 ntraceurs_zone=0 726 ntraceurs_zone_prec=0 727 ntraciso=0 728 729 do iq=nqo+1,nqtot 730 write(lunout,*) 'infotrac 569: iq,tnom_0(iq)=',iq,tnom_0(iq) 731 do phase=1,nqo 732 do ixt= 1,niso_possibles 733 tnom_trac=trim(tnom_0(phase))//'_' 734 tnom_trac=trim(tnom_trac)//trim(tnom_iso(ixt)) 735 write(*,*) 'phase,ixt,tnom_trac=',phase,ixt,tnom_trac 736 IF (tnom_0(iq) == tnom_trac) then 737 write(lunout,*) 'Ce traceur est un isotope' 738 nb_iso(ixt,phase)=nb_iso(ixt,phase)+1 739 nb_isoind(phase)=nb_isoind(phase)+1 740 iso_num(iq)=ixt 741 iso_indnum(iq)=nb_isoind(phase) 742 indnum_fn_num(ixt)=iso_indnum(iq) 743 phase_num(iq)=phase 744 write(lunout,*) 'iso_num(iq)=',iso_num(iq) 745 write(lunout,*) 'iso_indnum(iq)=',iso_indnum(iq) 746 write(lunout,*) 'indnum_fn_num(ixt)=',indnum_fn_num(ixt) 747 write(lunout,*) 'phase_num(iq)=',phase_num(iq) 748 goto 20 749 else if (iqpere(iq).gt.0) then 750 if (tnom_0(iqpere(iq)) == tnom_trac) then 751 write(lunout,*) 'Ce traceur est le fils d''un isotope' 752 ! c'est un traceur d'isotope 753 nb_traciso(ixt,phase)=nb_traciso(ixt,phase)+1 754 iso_num(iq)=ixt 755 iso_indnum(iq)=indnum_fn_num(ixt) 756 zone_num(iq)=nb_traciso(ixt,phase) 757 phase_num(iq)=phase 758 write(lunout,*) 'iso_num(iq)=',iso_num(iq) 759 write(lunout,*) 'phase_num(iq)=',phase_num(iq) 760 write(lunout,*) 'zone_num(iq)=',zone_num(iq) 761 goto 20 762 endif !if (tnom_0(iqpere(iq)) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then 763 endif !IF (tnom_0(iq) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then 764 enddo !do ixt= niso_possibles 765 enddo !do phase=1,nqo 766 20 continue 767 enddo !do iq=1,nqtot 768 769 write(lunout,*) 'iso_num=',iso_num 770 write(lunout,*) 'iso_indnum=',iso_indnum 771 write(lunout,*) 'zone_num=',zone_num 772 write(lunout,*) 'phase_num=',phase_num 773 write(lunout,*) 'indnum_fn_num=',indnum_fn_num 774 775 do ixt= 1,niso_possibles 776 777 if (nqo.gt.0) then ! Ehouarn: because tests below only valid if nqo>=1, 778 779 if (nb_iso(ixt,1).eq.1) then 780 ! on vérifie que toutes les phases ont le même nombre de 781 ! traceurs 782 do phase=2,nqo 783 if (nb_iso(ixt,phase).ne.nb_iso(ixt,1)) then 784 ! write(lunout,*) 'ixt,phase,nb_iso=',ixt,phase,nb_iso(ixt,phase) 785 CALL abort_gcm('infotrac_init','Phases must have same number of isotopes',1) 786 endif 787 enddo !do phase=2,nqo 788 789 niso=niso+1 790 use_iso(ixt)=.true. 791 ntraceurs_zone=nb_traciso(ixt,1) 792 793 ! on vérifie que toutes les phases ont le même nombre de 794 ! traceurs 795 do phase=2,nqo 796 if (nb_traciso(ixt,phase).ne.ntraceurs_zone) then 797 write(lunout,*) 'ixt,phase,nb_traciso=',ixt,phase,nb_traciso(ixt,phase) 798 write(lunout,*) 'ntraceurs_zone=',ntraceurs_zone 799 CALL abort_gcm('infotrac_init','Phases must have same number of tracers',1) 800 endif 801 enddo !do phase=2,nqo 802 ! on vérifie que tous les isotopes ont le même nombre de 803 ! traceurs 804 if (ntraceurs_zone_prec.gt.0) then 805 if (ntraceurs_zone.eq.ntraceurs_zone_prec) then 806 ntraceurs_zone_prec=ntraceurs_zone 807 else !if (ntraceurs_zone.eq.ntraceurs_zone_prec) then 808 write(*,*) 'ntraceurs_zone_prec,ntraceurs_zone=',ntraceurs_zone_prec,ntraceurs_zone 809 CALL abort_gcm('infotrac_init', & 810 &'Isotope tracers are not well defined in traceur.def',1) 811 endif !if (ntraceurs_zone.eq.ntraceurs_zone_prec) then 812 endif !if (ntraceurs_zone_prec.gt.0) then 813 814 else if (nb_iso(ixt,1).ne.0) then 815 WRITE(lunout,*) 'nqo,ixt=',nqo,ixt 816 WRITE(lunout,*) 'nb_iso(ixt,1)=',nb_iso(ixt,1) 817 CALL abort_gcm('infotrac_init','Isotopes are not well defined in traceur.def',1) 818 endif !if (nb_iso(ixt,1).eq.1) then 819 820 endif ! of if (nqo.gt.0) 821 822 enddo ! do ixt= niso_possibles 823 824 ! dimensions isotopique: 825 ntraciso=niso*(ntraceurs_zone+1) 826 WRITE(lunout,*) 'niso=',niso 827 WRITE(lunout,*) 'ntraceurs_zone,ntraciso=',ntraceurs_zone,ntraciso 828 829 ! flags isotopiques: 830 if (niso.gt.0) then 831 ok_isotopes=.true. 832 else 833 ok_isotopes=.false. 834 endif 835 WRITE(lunout,*) 'ok_isotopes=',ok_isotopes 836 837 if (ok_isotopes) then 838 ok_iso_verif=.false. 839 call getin('ok_iso_verif',ok_iso_verif) 840 ok_init_iso=.false. 841 call getin('ok_init_iso',ok_init_iso) 842 tnat=(/1.0,155.76e-6,2005.2e-6,0.004/100.,0.0/) 843 alpha_ideal=(/1.0,1.01,1.006,1.003,1.0/) 844 endif !if (ok_isotopes) then 845 WRITE(lunout,*) 'ok_iso_verif=',ok_iso_verif 846 WRITE(lunout,*) 'ok_init_iso=',ok_init_iso 847 848 if (ntraceurs_zone.gt.0) then 849 ok_isotrac=.true. 850 else 851 ok_isotrac=.false. 852 endif 853 WRITE(lunout,*) 'ok_isotrac=',ok_isotrac 854 855 ! remplissage du tableau iqiso(ntraciso,phase) 856 ALLOCATE(iqiso(ntraciso,nqo)) 857 iqiso(:,:)=0 858 do iq=1,nqtot 859 if (iso_num(iq).gt.0) then 860 ixt=iso_indnum(iq)+zone_num(iq)*niso 861 iqiso(ixt,phase_num(iq))=iq 862 endif 863 enddo 864 ! WRITE(lunout,*) 'iqiso=',iqiso 865 866 ! replissage du tableau index_trac(ntraceurs_zone,niso) 867 ALLOCATE(index_trac(ntraceurs_zone,niso)) 868 if (ok_isotrac) then 869 do iiso=1,niso 870 do izone=1,ntraceurs_zone 871 index_trac(izone,iiso)=iiso+izone*niso 872 enddo 873 enddo 874 else !if (ok_isotrac) then 875 index_trac(:,:)=0.0 876 endif !if (ok_isotrac) then 877 write(lunout,*) 'index_trac=',index_trac 878 879 ! Finalize : 880 DEALLOCATE(nb_iso) 881 882 END SUBROUTINE infotrac_isoinit 883 884 !----------------------------------------------------------------------- 445 885 446 886 ! Ehouarn: routine iniadvtrac => from Mars/generic; does essentially the -
trunk/LMDZ.COMMON/libf/dyn3d_common/iniacademic.F90
r1422 r1508 5 5 6 6 USE filtreg_mod, ONLY: inifilr 7 USE infotrac, ONLY : nqtot 7 USE infotrac, ONLY : nqtot, ok_isotopes, iso_num, zone_num, & 8 iqpere, tnat, alpha_ideal, iso_indnum, & 9 phase_num, iqiso, ok_iso_verif 8 10 USE control_mod, ONLY: day_step,planet_type 9 11 #ifdef CPP_IOIPSL … … 262 264 if (i == 2) q(:,:,i)=1.e-15 263 265 if (i.gt.2) q(:,:,i)=0. 266 267 ! CRisi: init des isotopes 268 ! distill de Rayleigh très simplifiée 269 if (ok_isotopes) then 270 if ((iso_num(i).gt.0).and.(zone_num(i).eq.0)) then 271 q(:,:,i)=q(:,:,iqpere(i)) & 272 & *tnat(iso_num(i)) & 273 & *(q(:,:,iqpere(i))/30.e-3) & 274 & **(alpha_ideal(iso_num(i))-1) 275 endif 276 if ((iso_num(i).gt.0).and.(zone_num(i).eq.1)) then 277 q(:,:,i)=q(:,:,iqiso(iso_indnum(i),phase_num(i))) 278 endif 279 endif !if (ok_isotopes) then 280 264 281 enddo 265 282 else 266 283 q(:,:,:)=0 267 284 endif ! of if (planet_type=="earth") 285 286 if (ok_iso_verif) then 287 ! Ehouarn: this will onyly work in serial mode 288 ! call check_isotopes_seq(q,1,ip1jmp1,'iniacademic_loc') 289 endif !if (ok_iso_verif) then 268 290 269 291 ! add random perturbation to temperature -
trunk/LMDZ.COMMON/libf/dyn3d_common/pression.F90
r1506 r1508 1 SUBROUTINE pression( ngrid, ap, bp, ps, p ) 1 2 ! 2 ! $Header$ 3 ! 4 SUBROUTINE pression( ngrid, ap, bp, ps, p ) 5 c 3 !------------------------------------------------------------------------------- 4 ! Authors: P. Le Van , Fr.Hourdin 5 !------------------------------------------------------------------------------- 6 ! Purpose: Compute pressure p(l) at different levels from l = 1 (ground level) 7 ! to l = llm +1. Those levels correspond to the llm layers interfaces, 8 ! with p(ij,llm+1) = 0. and p(ij,1) = ps(ij) . 9 !------------------------------------------------------------------------------- 10 IMPLICIT NONE 11 include "dimensions.h" 12 include "paramet.h" 13 !=============================================================================== 14 ! Arguments: 15 INTEGER, INTENT(IN) :: ngrid !--- NUMBER OF GRID POINTS 16 REAL, INTENT(IN) :: ap(llmp1), bp(llmp1) !--- HYBRID COEFFICIENTS 17 REAL, INTENT(IN) :: ps(ngrid) !--- SURFACE PRESSURE 18 REAL, INTENT(OUT) :: p(ngrid,llmp1) !--- 3D PRESSURE FIELD 19 !=============================================================================== 20 ! Local variables: 21 INTEGER :: l 22 !=============================================================================== 23 DO l=1,llmp1; p(:,l) = ap(l) + bp(l) * ps(:); END DO 6 24 7 c Auteurs : P. Le Van , Fr.Hourdin . 25 END SUBROUTINE pression 8 26 9 c ************************************************************************ 10 c Calcule la pression p(l) aux differents niveaux l = 1 ( niveau du 11 c sol) a l = llm +1 ,ces niveaux correspondant aux interfaces des (llm) 12 c couches , avec p(ij,llm +1) = 0. et p(ij,1) = ps(ij) . 13 c ************************************************************************ 14 c 15 IMPLICIT NONE 16 c 17 #include "dimensions.h" 18 #include "paramet.h" 19 c 20 INTEGER ngrid 21 INTEGER l,ij 22 23 REAL ap( llmp1 ), bp( llmp1 ), ps( ngrid ), p( ngrid,llmp1 ) 24 25 DO l = 1, llmp1 26 DO ij = 1, ngrid 27 p(ij,l) = ap(l) + bp(l) * ps(ij) 28 ENDDO 29 ENDDO 30 31 RETURN 32 END 27
Note: See TracChangeset
for help on using the changeset viewer.
