Changeset 2299 for LMDZ5/trunk/libf/dyn3dmem
- Timestamp:
- Jun 15, 2015, 8:48:31 PM (10 years ago)
- Location:
- LMDZ5/trunk/libf/dyn3dmem
- Files:
-
- 1 edited
- 2 moved
-
dynetat0_loc.f90 (moved) (moved from LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.F) (1 diff)
-
dynredem_loc.F90 (moved) (moved from LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F) (1 diff)
-
dynredem_mod.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.f90
r2298 r2299 1 SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,teta,q,masse,ps,phis,time) 1 2 ! 2 ! $Id$ 3 !------------------------------------------------------------------------------- 4 ! Authors: P. Le Van , L.Fairhead 5 !------------------------------------------------------------------------------- 6 ! Purpose: Initial state reading. 7 !------------------------------------------------------------------------------- 8 USE parallel_lmdz 9 USE infotrac 10 USE netcdf, ONLY: NF90_OPEN, NF90_INQUIRE_DIMENSION, NF90_INQ_VARID, & 11 NF90_NOWRITE, NF90_CLOSE, NF90_INQUIRE_VARIABLE, NF90_GET_VAR, NF90_NoErr 12 USE control_mod, ONLY: planet_type 13 USE assert_eq_m, ONLY: assert_eq 14 IMPLICIT NONE 15 include "dimensions.h" 16 include "paramet.h" 17 include "temps.h" 18 include "comconst.h" 19 include "comvert.h" 20 include "comgeom.h" 21 include "ener.h" 22 include "description.h" 23 include "serre.h" 24 include "logic.h" 25 include "iniprint.h" 26 !=============================================================================== 27 ! Arguments: 28 CHARACTER(LEN=*), INTENT(IN) :: fichnom !--- FILE NAME 29 REAL, INTENT(OUT) :: vcov(ijb_v:ije_v,llm) !--- V COVARIANT WIND 30 REAL, INTENT(OUT) :: ucov(ijb_u:ije_u,llm) !--- U COVARIANT WIND 31 REAL, INTENT(OUT) :: teta(ijb_u:ije_u,llm) !--- POTENTIAL TEMP. 32 REAL, INTENT(OUT) :: q(ijb_u:ije_u,llm,nqtot)!--- TRACERS 33 REAL, INTENT(OUT) :: masse(ijb_u:ije_u,llm) !--- MASS PER CELL 34 REAL, INTENT(OUT) :: ps(ijb_u:ije_u) !--- GROUND PRESSURE 35 REAL, INTENT(OUT) :: phis(ijb_u:ije_u) !--- GEOPOTENTIAL 36 !=============================================================================== 37 ! Local variables: 38 CHARACTER(LEN=256) :: msg, var, modname 39 INTEGER, PARAMETER :: length=100 40 INTEGER :: iq, fID, vID, idecal, ierr 41 REAL :: time, tab_cntrl(length) !--- RUN PARAMS TABLE 42 REAL, ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:), ps_glo(:) 43 REAL, ALLOCATABLE :: ucov_glo(:,:), q_glo(:,:), phis_glo(:) 44 REAL, ALLOCATABLE :: teta_glo(:,:) 45 !------------------------------------------------------------------------------- 46 modname="dynetat0_loc" 47 48 !--- Initial state file opening 49 var=fichnom 50 CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var) 51 CALL get_var1("controle",tab_cntrl) 52 53 !!! AS: idecal is a hack to be able to read planeto starts... 54 !!! .... while keeping everything OK for LMDZ EARTH 55 IF(planet_type=="generic") THEN 56 WRITE(lunout,*)'NOTE NOTE NOTE : Planeto-like start files' 57 idecal = 4 58 annee_ref = 2000 59 ELSE 60 WRITE(lunout,*)'NOTE NOTE NOTE : Earth-like start files' 61 idecal = 5 62 annee_ref = tab_cntrl(5) 63 END IF 64 im = tab_cntrl(1) 65 jm = tab_cntrl(2) 66 lllm = tab_cntrl(3) 67 day_ref = tab_cntrl(4) 68 rad = tab_cntrl(idecal+1) 69 omeg = tab_cntrl(idecal+2) 70 g = tab_cntrl(idecal+3) 71 cpp = tab_cntrl(idecal+4) 72 kappa = tab_cntrl(idecal+5) 73 daysec = tab_cntrl(idecal+6) 74 dtvr = tab_cntrl(idecal+7) 75 etot0 = tab_cntrl(idecal+8) 76 ptot0 = tab_cntrl(idecal+9) 77 ztot0 = tab_cntrl(idecal+10) 78 stot0 = tab_cntrl(idecal+11) 79 ang0 = tab_cntrl(idecal+12) 80 pa = tab_cntrl(idecal+13) 81 preff = tab_cntrl(idecal+14) 3 82 ! 4 SUBROUTINE dynetat0_loc(fichnom,vcov,ucov, 5 . teta,q,masse,ps,phis,time) 6 USE infotrac 7 use control_mod, only : planet_type 8 USE parallel_lmdz 9 IMPLICIT NONE 10 11 c======================================================================= 12 c 13 c Auteur: P. Le Van / L.Fairhead 14 c ------- 15 c 16 c objet: 17 c ------ 18 c 19 c Lecture de l'etat initial 20 c 21 c======================================================================= 22 c----------------------------------------------------------------------- 23 c Declarations: 24 c ------------- 25 26 #include "dimensions.h" 27 #include "paramet.h" 28 #include "temps.h" 29 #include "comconst.h" 30 #include "comvert.h" 31 #include "comgeom.h" 32 #include "ener.h" 33 #include "netcdf.inc" 34 #include "description.h" 35 #include "serre.h" 36 #include "logic.h" 37 #include "iniprint.h" 38 39 c Arguments: 40 c ---------- 41 42 CHARACTER*(*) fichnom 43 REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm) 44 REAL teta(ijb_u:ije_u,llm) 45 REAL q(ijb_u:ije_u,llm,nqtot),masse(ijb_u:ije_u,llm) 46 REAL ps(ijb_u:ije_u),phis(ijb_u:ije_u) 47 48 REAL time 49 50 c Variables 51 c 52 INTEGER length,iq 53 PARAMETER (length = 100) 54 REAL tab_cntrl(length) ! tableau des parametres du run 55 INTEGER ierr, nid, nvarid 56 REAL,ALLOCATABLE :: vcov_glo(:,:),ucov_glo(:,:),teta_glo(:,:) 57 REAL,ALLOCATABLE :: q_glo(:,:),masse_glo(:,:),ps_glo(:) 58 REAL,ALLOCATABLE :: phis_glo(:) 59 60 INTEGER idecal 61 62 c----------------------------------------------------------------------- 63 c Ouverture NetCDF du fichier etat initial 64 65 ierr = NF_OPEN (fichnom, NF_NOWRITE,nid) 66 IF (ierr.NE.NF_NOERR) THEN 67 write(lunout,*) 68 & 'dynetat0_loc: Pb d''ouverture du fichier start.nc' 69 write(lunout,*)' ierr = ', ierr 70 CALL ABORT_GCM("DYNETAT0", "", 1) 71 ENDIF 72 73 c 74 ierr = NF_INQ_VARID (nid, "controle", nvarid) 75 IF (ierr .NE. NF_NOERR) THEN 76 write(lunout,*)"dynetat0_loc: Le champ <controle> est absent" 77 CALL abort_gcm("dynetat0", "", 1) 78 ENDIF 79 #ifdef NC_DOUBLE 80 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl) 81 #else 82 ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl) 83 #endif 84 IF (ierr .NE. NF_NOERR) THEN 85 write(lunout,*)"dynetat0_loc: Lecture echoue pour <controle>" 86 CALL abort_gcm("dynetat0", "", 1) 87 ENDIF 88 89 !!! AS: idecal is a hack to be able to read planeto starts... 90 !!! .... while keeping everything OK for LMDZ EARTH 91 if (planet_type.eq."generic") then 92 print*,'NOTE NOTE NOTE : Planeto-like start files' 93 idecal = 4 94 annee_ref = 2000 95 else 96 print*,'NOTE NOTE NOTE : Earth-like start files' 97 idecal = 5 98 annee_ref = tab_cntrl(5) 99 endif 100 101 102 im = tab_cntrl(1) 103 jm = tab_cntrl(2) 104 lllm = tab_cntrl(3) 105 day_ref = tab_cntrl(4) 106 rad = tab_cntrl(idecal+1) 107 omeg = tab_cntrl(idecal+2) 108 g = tab_cntrl(idecal+3) 109 cpp = tab_cntrl(idecal+4) 110 kappa = tab_cntrl(idecal+5) 111 daysec = tab_cntrl(idecal+6) 112 dtvr = tab_cntrl(idecal+7) 113 etot0 = tab_cntrl(idecal+8) 114 ptot0 = tab_cntrl(idecal+9) 115 ztot0 = tab_cntrl(idecal+10) 116 stot0 = tab_cntrl(idecal+11) 117 ang0 = tab_cntrl(idecal+12) 118 pa = tab_cntrl(idecal+13) 119 preff = tab_cntrl(idecal+14) 120 c 121 clon = tab_cntrl(idecal+15) 122 clat = tab_cntrl(idecal+16) 123 grossismx = tab_cntrl(idecal+17) 124 grossismy = tab_cntrl(idecal+18) 125 c 126 IF ( tab_cntrl(idecal+19).EQ.1. ) THEN 127 fxyhypb = . TRUE . 128 c dzoomx = tab_cntrl(25) 129 c dzoomy = tab_cntrl(26) 130 c taux = tab_cntrl(28) 131 c tauy = tab_cntrl(29) 132 ELSE 133 fxyhypb = . FALSE . 134 ysinus = . FALSE . 135 IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE. 136 ENDIF 137 138 day_ini = tab_cntrl(30) 139 itau_dyn = tab_cntrl(31) 140 c ................................................................. 141 c 142 c 143 write(lunout,*)'dynetat0_loc: rad,omeg,g,cpp,kappa', 144 & rad,omeg,g,cpp,kappa 145 146 IF( im.ne.iim ) THEN 147 PRINT 1,im,iim 148 STOP 149 ELSE IF( jm.ne.jjm ) THEN 150 PRINT 2,jm,jjm 151 STOP 152 ELSE IF( lllm.ne.llm ) THEN 153 PRINT 3,lllm,llm 154 STOP 155 ENDIF 156 157 ierr = NF_INQ_VARID (nid, "rlonu", nvarid) 158 IF (ierr .NE. NF_NOERR) THEN 159 write(lunout,*)"dynetat0_loc: Le champ <rlonu> est absent" 160 CALL abort_gcm("dynetat0", "", 1) 161 ENDIF 162 #ifdef NC_DOUBLE 163 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu) 164 #else 165 ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu) 166 #endif 167 IF (ierr .NE. NF_NOERR) THEN 168 write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonu>" 169 CALL abort_gcm("dynetat0", "", 1) 170 ENDIF 171 172 ierr = NF_INQ_VARID (nid, "rlatu", nvarid) 173 IF (ierr .NE. NF_NOERR) THEN 174 write(lunout,*)"dynetat0_loc: Le champ <rlatu> est absent" 175 CALL abort_gcm("dynetat0", "", 1) 176 ENDIF 177 #ifdef NC_DOUBLE 178 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu) 179 #else 180 ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu) 181 #endif 182 IF (ierr .NE. NF_NOERR) THEN 183 write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlatu>" 184 CALL abort_gcm("dynetat0", "", 1) 185 ENDIF 186 187 ierr = NF_INQ_VARID (nid, "rlonv", nvarid) 188 IF (ierr .NE. NF_NOERR) THEN 189 write(lunout,*)"dynetat0_loc: Le champ <rlonv> est absent" 190 CALL abort_gcm("dynetat0", "", 1) 191 ENDIF 192 #ifdef NC_DOUBLE 193 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv) 194 #else 195 ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv) 196 #endif 197 IF (ierr .NE. NF_NOERR) THEN 198 write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonv>" 199 CALL abort_gcm("dynetat0", "", 1) 200 ENDIF 201 202 ierr = NF_INQ_VARID (nid, "rlatv", nvarid) 203 IF (ierr .NE. NF_NOERR) THEN 204 write(lunout,*)"dynetat0_loc: Le champ <rlatv> est absent" 205 CALL abort_gcm("dynetat0", "", 1) 206 ENDIF 207 #ifdef NC_DOUBLE 208 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv) 209 #else 210 ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv) 211 #endif 212 IF (ierr .NE. NF_NOERR) THEN 213 write(lunout,*)"dynetat0_loc: Lecture echouee pour rlatv" 214 CALL abort_gcm("dynetat0", "", 1) 215 ENDIF 216 217 ierr = NF_INQ_VARID (nid, "cu", nvarid) 218 IF (ierr .NE. NF_NOERR) THEN 219 write(lunout,*)"dynetat0_loc: Le champ <cu> est absent" 220 CALL abort_gcm("dynetat0", "", 1) 221 ENDIF 222 #ifdef NC_DOUBLE 223 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu) 224 #else 225 ierr = NF_GET_VAR_REAL(nid, nvarid, cu) 226 #endif 227 IF (ierr .NE. NF_NOERR) THEN 228 write(lunout,*)"dynetat0_loc: Lecture echouee pour <cu>" 229 CALL abort_gcm("dynetat0", "", 1) 230 ENDIF 231 232 ierr = NF_INQ_VARID (nid, "cv", nvarid) 233 IF (ierr .NE. NF_NOERR) THEN 234 write(lunout,*)"dynetat0_loc: Le champ <cv> est absent" 235 CALL abort_gcm("dynetat0", "", 1) 236 ENDIF 237 #ifdef NC_DOUBLE 238 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv) 239 #else 240 ierr = NF_GET_VAR_REAL(nid, nvarid, cv) 241 #endif 242 IF (ierr .NE. NF_NOERR) THEN 243 write(lunout,*)"dynetat0_loc: Lecture echouee pour <cv>" 244 CALL abort_gcm("dynetat0", "", 1) 245 ENDIF 246 247 ierr = NF_INQ_VARID (nid, "aire", nvarid) 248 IF (ierr .NE. NF_NOERR) THEN 249 write(lunout,*)"dynetat0_loc: Le champ <aire> est absent" 250 CALL abort_gcm("dynetat0", "", 1) 251 ENDIF 252 #ifdef NC_DOUBLE 253 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire) 254 #else 255 ierr = NF_GET_VAR_REAL(nid, nvarid, aire) 256 #endif 257 IF (ierr .NE. NF_NOERR) THEN 258 write(lunout,*)"dynetat0_loc: Lecture echouee pour <aire>" 259 CALL abort_gcm("dynetat0", "", 1) 260 ENDIF 261 262 ALLOCATE(phis_glo(ip1jmp1)) 263 264 ierr = NF_INQ_VARID (nid, "phisinit", nvarid) 265 IF (ierr .NE. NF_NOERR) THEN 266 write(lunout,*)"dynetat0_loc: Le champ <phisinit> est absent" 267 CALL abort_gcm("dynetat0", "", 1) 268 ENDIF 269 #ifdef NC_DOUBLE 270 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis_glo) 271 #else 272 ierr = NF_GET_VAR_REAL(nid, nvarid, phis_glo) 273 #endif 274 IF (ierr .NE. NF_NOERR) THEN 275 write(lunout,*)"dynetat0_loc: Lecture echouee pour <phisinit>" 276 CALL abort_gcm("dynetat0", "", 1) 277 ENDIF 278 phis(ijb_u:ije_u)=phis_glo(ijb_u:ije_u) 279 DEALLOCATE(phis_glo) 280 281 ierr = NF_INQ_VARID (nid, "temps", nvarid) 282 IF (ierr .NE. NF_NOERR) THEN 283 write(lunout,*)"dynetat0: Le champ <temps> est absent" 284 write(lunout,*)"dynetat0: J essaie <Time>" 285 ierr = NF_INQ_VARID (nid, "Time", nvarid) 286 IF (ierr .NE. NF_NOERR) THEN 287 write(lunout,*)"dynetat0: Le champ <Time> est absent" 288 CALL abort_gcm("dynetat0", "", 1) 289 ENDIF 290 ENDIF 291 #ifdef NC_DOUBLE 292 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time) 293 #else 294 ierr = NF_GET_VAR_REAL(nid, nvarid, time) 295 #endif 296 IF (ierr .NE. NF_NOERR) THEN 297 write(lunout,*)"dynetat0_loc: Lecture echouee <temps>" 298 CALL abort_gcm("dynetat0", "", 1) 299 ENDIF 300 301 ierr = NF_INQ_VARID (nid, "ucov", nvarid) 302 IF (ierr .NE. NF_NOERR) THEN 303 write(lunout,*)"dynetat0_loc: Le champ <ucov> est absent" 304 CALL abort_gcm("dynetat0", "", 1) 305 ENDIF 306 307 ALLOCATE(ucov_glo(ip1jmp1,llm)) 308 309 #ifdef NC_DOUBLE 310 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov_glo) 311 #else 312 ierr = NF_GET_VAR_REAL(nid, nvarid, ucov_glo) 313 #endif 314 IF (ierr .NE. NF_NOERR) THEN 315 write(lunout,*)"dynetat0_loc: Lecture echouee pour <ucov>" 316 CALL abort_gcm("dynetat0", "", 1) 317 ENDIF 318 319 ucov(ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:) 320 DEALLOCATE(ucov_glo) 321 ALLOCATE(vcov_glo(ip1jm,llm)) 322 323 ierr = NF_INQ_VARID (nid, "vcov", nvarid) 324 IF (ierr .NE. NF_NOERR) THEN 325 write(lunout,*)"dynetat0_loc: Le champ <vcov> est absent" 326 CALL abort_gcm("dynetat0", "", 1) 327 ENDIF 328 #ifdef NC_DOUBLE 329 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov_glo) 330 #else 331 ierr = NF_GET_VAR_REAL(nid, nvarid, vcov_glo) 332 #endif 333 IF (ierr .NE. NF_NOERR) THEN 334 write(lunout,*)"dynetat0_loc: Lecture echouee pour <vcov>" 335 CALL abort_gcm("dynetat0", "", 1) 336 ENDIF 337 vcov(ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:) 338 DEALLOCATE(vcov_glo) 339 ALLOCATE(teta_glo(ip1jmp1,llm)) 340 341 ierr = NF_INQ_VARID (nid, "teta", nvarid) 342 IF (ierr .NE. NF_NOERR) THEN 343 write(lunout,*)"dynetat0_loc: Le champ <teta> est absent" 344 CALL abort_gcm("dynetat0", "", 1) 345 ENDIF 346 #ifdef NC_DOUBLE 347 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta_glo) 348 #else 349 ierr = NF_GET_VAR_REAL(nid, nvarid, teta_glo) 350 #endif 351 IF (ierr .NE. NF_NOERR) THEN 352 write(lunout,*)"dynetat0_loc: Lecture echouee pour <teta>" 353 CALL abort_gcm("dynetat0", "", 1) 354 ENDIF 355 356 teta(ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:) 357 DEALLOCATE(teta_glo) 358 ALLOCATE(q_glo(ip1jmp1,llm)) 359 360 361 DO iq=1,nqtot 362 ierr = NF_INQ_VARID (nid, tname(iq), nvarid) 363 IF (ierr .NE. NF_NOERR) THEN 364 write(lunout,*)"dynetat0_loc: Le traceur <" & 365 & //trim(tname(iq))//"> est absent" 366 write(lunout,*)"Il est donc initialise a zero" 367 q(:,:,iq)=0. 368 369 ! CRisi: pour les isotopes, on peut faire init théorique 370 ! distill de Rayleigh très simplifiée 371 if (ok_isotopes) then 372 if ((iso_num(iq).gt.0).and.(zone_num(iq).eq.0)) then 373 q(:,:,iq)=q(:,:,iqpere(iq)) & 374 & *tnat(iso_num(iq)) & 375 & *(q(:,:,iqpere(iq))/30.e-3) & 376 & **(alpha_ideal(iso_num(iq))-1) 377 endif 378 if ((iso_num(iq).gt.0).and.(zone_num(iq).eq.1)) then 379 q(:,:,iq)=q(:,:,iqiso(iso_indnum(iq),phase_num(iq))) 380 endif 381 endif !if (ok_isotopes) then 382 383 ELSE 384 #ifdef NC_DOUBLE 385 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_glo) 386 #else 387 ierr = NF_GET_VAR_REAL(nid, nvarid, q_glo) 388 #endif 389 IF (ierr .NE. NF_NOERR) THEN 390 write(lunout,*) 391 & "dynetat0_loc: Lecture echouee pour "//tname(iq) 392 CALL abort_gcm("dynetat0", "", 1) 393 ENDIF 394 q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:) 395 396 ENDIF 397 ENDDO !DO iq=1,nqtot 398 399 if (ok_iso_verif) then 400 call check_isotopes(q,ijb_u,ije_u,'dynetat0_loc') 401 endif !if (ok_iso_verif) then 402 403 DEALLOCATE(q_glo) 404 ALLOCATE(masse_glo(ip1jmp1,llm)) 405 406 ierr = NF_INQ_VARID (nid, "masse", nvarid) 407 IF (ierr .NE. NF_NOERR) THEN 408 write(lunout,*)"dynetat0_loc: Le champ <masse> est absent" 409 CALL abort_gcm("dynetat0", "", 1) 410 ENDIF 411 #ifdef NC_DOUBLE 412 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse_glo) 413 #else 414 ierr = NF_GET_VAR_REAL(nid, nvarid, masse_glo) 415 #endif 416 IF (ierr .NE. NF_NOERR) THEN 417 write(lunout,*)"dynetat0_loc: Lecture echouee pour <masse>" 418 CALL abort_gcm("dynetat0", "", 1) 419 ENDIF 420 masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:) 421 DEALLOCATE(masse_glo) 422 ALLOCATE(ps_glo(ip1jmp1)) 423 424 ierr = NF_INQ_VARID (nid, "ps", nvarid) 425 IF (ierr .NE. NF_NOERR) THEN 426 write(lunout,*)"dynetat0_loc: Le champ <ps> est absent" 427 CALL abort_gcm("dynetat0", "", 1) 428 ENDIF 429 #ifdef NC_DOUBLE 430 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps_glo) 431 #else 432 ierr = NF_GET_VAR_REAL(nid, nvarid, ps_glo) 433 #endif 434 IF (ierr .NE. NF_NOERR) THEN 435 write(lunout,*)"dynetat0_loc: Lecture echouee pour <ps>" 436 CALL abort_gcm("dynetat0", "", 1) 437 ENDIF 438 439 ps(ijb_u:ije_u)=ps_glo(ijb_u:ije_u) 440 DEALLOCATE(ps_glo) 441 442 ierr = NF_CLOSE(nid) 443 444 day_ini=day_ini+INT(time) 445 time=time-INT(time) 446 447 1 FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem 448 *arrage est differente de la valeur parametree iim =',i4//) 449 2 FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem 450 *arrage est differente de la valeur parametree jjm =',i4//) 451 3 FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema 452 *rrage est differente de la valeur parametree llm =',i4//) 453 4 FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema 454 *rrage est differente de la valeur dtinteg =',i4//) 455 456 RETURN 457 END 83 clon = tab_cntrl(idecal+15) 84 clat = tab_cntrl(idecal+16) 85 grossismx = tab_cntrl(idecal+17) 86 grossismy = tab_cntrl(idecal+18) 87 ! 88 IF ( tab_cntrl(idecal+19)==1. ) THEN 89 fxyhypb = .TRUE. 90 ! dzoomx = tab_cntrl(25) 91 ! dzoomy = tab_cntrl(26) 92 ! taux = tab_cntrl(28) 93 ! tauy = tab_cntrl(29) 94 ELSE 95 fxyhypb = .FALSE. 96 ysinus = tab_cntrl(idecal+22)==1. 97 END IF 98 99 day_ini = tab_cntrl(30) 100 itau_dyn = tab_cntrl(31) 101 ! start_time = tab_cntrl(32) ???? 102 103 !------------------------------------------------------------------------------- 104 WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa 105 CALL check_dim(im,iim,'im','im') 106 CALL check_dim(jm,jjm,'jm','jm') 107 CALL check_dim(lllm,llm,'lm','lllm') 108 CALL get_var1("rlonu",rlonu) 109 CALL get_var1("rlatu",rlatu) 110 CALL get_var1("rlonv",rlonv) 111 CALL get_var1("rlatv",rlatv) 112 CALL get_var1("cu" ,cu) 113 CALL get_var1("cv" ,cv) 114 CALL get_var1("aire",aire) 115 116 var="temps" 117 IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN 118 WRITE(lunout,*)TRIM(modname)//": missing field <temps>" 119 WRITE(lunout,*)TRIM(modname)//": trying with <Time>"; var="Time" 120 CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) 121 END IF 122 CALL err(NF90_GET_VAR(fID,vID,time),"get",var) 123 124 ALLOCATE(phis_glo(ip1jmp1)) 125 CALL get_var1("phisinit",phis_glo) 126 phis (ijb_u:ije_u) =phis_glo(ijb_u:ije_u); DEALLOCATE(phis_glo) 127 128 ALLOCATE(ucov_glo(ip1jmp1,llm)) 129 CALL get_var2("ucov",ucov_glo) 130 ucov (ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:); DEALLOCATE(ucov_glo) 131 132 ALLOCATE(vcov_glo(ip1jm,llm)) 133 CALL get_var2("vcov",vcov_glo) 134 vcov (ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:); DEALLOCATE(vcov_glo) 135 136 ALLOCATE(teta_glo(ip1jmp1,llm)) 137 CALL get_var2("teta",teta_glo) 138 teta (ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:); DEALLOCATE(teta_glo) 139 140 ALLOCATE(masse_glo(ip1jmp1,llm)) 141 CALL get_var2("masse",masse_glo) 142 masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:); DEALLOCATE(masse_glo) 143 144 ALLOCATE(ps_glo(ip1jmp1)) 145 CALL get_var1("ps",ps_glo) 146 ps (ijb_u:ije_u) = ps_glo(ijb_u:ije_u); DEALLOCATE(ps_glo) 147 148 !--- Tracers 149 ALLOCATE(q_glo(ip1jmp1,llm)) 150 DO iq=1,nqtot 151 var=tname(iq) 152 IF(NF90_INQ_VARID(fID,var,vID)==NF90_NoErr) THEN 153 CALL get_var2(var,q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:); CYCLE 154 END IF 155 WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing" 156 WRITE(lunout,*)" It is hence initialized to zero" 157 q(ijb_u:ije_u,:,iq)=0. 158 !--- CRisi: for isotops, theoretical initialization using very simplified 159 ! Rayleigh distillation las. 160 IF(ok_isotopes.AND.iso_num(iq)>0) THEN 161 IF(zone_num(iq)==0) q(:,:,iq)=q(:,:,iqpere(iq))*tnat(iso_num(iq)) & 162 & *(q(:,:,iqpere(iq))/30.e-3)**(alpha_ideal(iso_num(iq))-1) 163 IF(zone_num(iq)==1) q(:,:,iq)=q(:,:,iqiso(iso_indnum(iq),phase_num(iq))) 164 END IF 165 END DO 166 DEALLOCATE(q_glo) 167 CALL err(NF90_CLOSE(fID),"close",fichnom) 168 day_ini=day_ini+INT(time) 169 time=time-INT(time) 170 171 172 CONTAINS 173 174 175 SUBROUTINE check_dim(n1,n2,str1,str2) 176 INTEGER, INTENT(IN) :: n1, n2 177 CHARACTER(LEN=*), INTENT(IN) :: str1, str2 178 CHARACTER(LEN=256) :: s1, s2 179 IF(n1/=n2) THEN 180 s1='value of '//TRIM(str1)//' =' 181 s2=' read in starting file differs from parametrized '//TRIM(str2)//' =' 182 WRITE(msg,'(10x,a,i4,2x,a,i4)'),s1,n1,s2,n2 183 CALL ABORT_gcm(TRIM(modname),TRIM(msg),1) 184 END IF 185 END SUBROUTINE check_dim 186 187 188 SUBROUTINE get_var1(var,v) 189 CHARACTER(LEN=*), INTENT(IN) :: var 190 REAL, INTENT(OUT) :: v(:) 191 REAL, ALLOCATABLE :: w2(:,:), w3(:,:,:) 192 INTEGER :: nn(3), dids(3), k, nd, ntot 193 194 CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) 195 ierr=NF90_INQUIRE_VARIABLE(fID,vID,ndims=nd) 196 IF(nd==1) THEN 197 CALL err(NF90_GET_VAR(fID,vID,v),"get",var); RETURN 198 END IF 199 ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids) 200 DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO 201 ntot=PRODUCT(nn(1:nd)) 202 SELECT CASE(nd) 203 CASE(2); ALLOCATE(w2(nn(1),nn(2))) 204 CALL err(NF90_GET_VAR(fID,vID,w2),"get",var) 205 v=RESHAPE(w2,[ntot]); DEALLOCATE(w2) 206 CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3))) 207 CALL err(NF90_GET_VAR(fID,vID,w3),"get",var) 208 v=RESHAPE(w3,[ntot]); DEALLOCATE(w3) 209 END SELECT 210 END SUBROUTINE get_var1 211 212 213 SUBROUTINE get_var2(var,v) 214 CHARACTER(LEN=*), INTENT(IN) :: var 215 REAL, INTENT(OUT) :: v(:,:) 216 REAL, ALLOCATABLE :: w4(:,:,:,:) 217 INTEGER :: nn(4), dids(4), k, nd 218 CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) 219 ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids,ndims=nd) 220 DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO 221 ALLOCATE(w4(nn(1),nn(2),nn(3),nn(4))) 222 CALL err(NF90_GET_VAR(fID,vID,w4),"get",var) 223 v=RESHAPE(w4,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w4) 224 END SUBROUTINE get_var2 225 226 227 SUBROUTINE err(ierr,typ,nam) 228 INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE 229 CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION 230 CHARACTER(LEN=*), INTENT(IN) :: nam !--- FIELD/FILE NAME 231 IF(ierr==NF90_NoERR) RETURN 232 SELECT CASE(typ) 233 CASE('inq'); msg="Field <"//TRIM(nam)//"> is missing" 234 CASE('get'); msg="Reading failed for <"//TRIM(nam)//">" 235 CASE('open'); msg="File opening failed for <"//TRIM(nam)//">" 236 CASE('close'); msg="File closing failed for <"//TRIM(nam)//">" 237 END SELECT 238 CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr) 239 END SUBROUTINE err 240 241 END SUBROUTINE dynetat0_loc -
LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F90
r2298 r2299 1 ! 2 ! $Id$3 ! 4 c 5 SUBROUTINE dynredem0_loc(fichnom,iday_end,phis) 1 SUBROUTINE dynredem0_loc(fichnom,iday_end,phis) 2 ! 3 !------------------------------------------------------------------------------- 4 ! Write the NetCDF restart file (initialization). 5 !------------------------------------------------------------------------------- 6 6 #ifdef CPP_IOIPSL 7 7 USE IOIPSL 8 8 #endif 9 USE parallel_lmdz 10 USE mod_hallo 11 USE infotrac 12 IMPLICIT NONE 13 c======================================================================= 14 c Ecriture du fichier de redemarrage sous format NetCDF (initialisation) 15 c======================================================================= 16 c Declarations: 17 c ------------- 18 #include "dimensions.h" 19 #include "paramet.h" 20 #include "comconst.h" 21 #include "comvert.h" 22 #include "comgeom.h" 23 #include "temps.h" 24 #include "ener.h" 25 #include "logic.h" 26 #include "netcdf.inc" 27 #include "description.h" 28 #include "serre.h" 29 #include "iniprint.h" 30 31 c Arguments: 32 c ---------- 33 INTEGER iday_end 34 REAL phis(ijb_u:ije_u) 35 CHARACTER*(*) fichnom 36 37 c Local: 38 c ------ 39 INTEGER iq,l 40 INTEGER length 41 PARAMETER (length = 100) 42 REAL tab_cntrl(length) ! tableau des parametres du run 43 INTEGER ierr 44 character*20 modname 45 character*80 abort_message 46 47 c Variables locales pour NetCDF: 48 c 49 INTEGER dims2(2), dims3(3), dims4(4) 50 INTEGER idim_index 51 INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv 52 INTEGER idim_s, idim_sig 53 INTEGER idim_tim 54 INTEGER nid,nvarid 55 56 REAL zan0,zjulian,hours 57 INTEGER yyears0,jjour0, mmois0 58 character*30 unites 59 REAL :: phis_glo(ip1jmp1) 60 61 CALL Gather_field_u(phis,phis_glo,1) 62 63 64 c----------------------------------------------------------------------- 65 if (mpi_rank==0) then 66 67 modname='dynredem0_loc' 9 USE parallel_lmdz 10 USE mod_hallo 11 USE infotrac 12 USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL, & 13 NF90_CLOSE, NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER 14 USE dynredem_mod, ONLY: cre_var, put_var, err, modname, fil 15 IMPLICIT NONE 16 include "dimensions.h" 17 include "paramet.h" 18 include "comconst.h" 19 include "comvert.h" 20 include "comgeom.h" 21 include "temps.h" 22 include "ener.h" 23 include "logic.h" 24 include "description.h" 25 include "serre.h" 26 include "iniprint.h" 27 !=============================================================================== 28 ! Arguments: 29 CHARACTER(LEN=*), INTENT(IN) :: fichnom !--- FILE NAME 30 INTEGER, INTENT(IN) :: iday_end !--- 31 REAL, INTENT(IN) :: phis(ijb_u:ije_u)!--- GROUND GEOPOTENTIAL 32 !=============================================================================== 33 ! Local variables: 34 INTEGER :: iq, l 35 INTEGER, PARAMETER :: length=100 36 REAL :: tab_cntrl(length) !--- RUN PARAMETERS TABLE 37 REAL :: phis_glo(ip1jmp1) 38 ! For NetCDF: 39 CHARACTER(LEN=30) :: unites 40 INTEGER :: indexID 41 INTEGER :: rlonuID, rlonvID, rlatuID, rlatvID 42 INTEGER :: sID, sigID, nID, vID, timID 43 INTEGER :: yyears0, jjour0, mmois0 44 REAL :: zan0, zjulian, hours 45 !=============================================================================== 46 modname='dynredem0'; fil=fichnom 47 CALL Gather_field_u(phis,phis_glo,1) 48 IF(mpi_rank/=0) RETURN 68 49 69 50 #ifdef CPP_IOIPSL 70 callymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)71 callju2ymds(zjulian, yyears0, mmois0, jjour0, hours)51 CALL ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian) 52 CALL ju2ymds(zjulian, yyears0, mmois0, jjour0, hours) 72 53 #else 73 54 ! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used) 74 yyears0=0 75 mmois0=1 76 jjour0=1 77 #endif 78 79 DO l=1,length 80 tab_cntrl(l) = 0. 81 ENDDO 82 tab_cntrl(1) = REAL(iim) 83 tab_cntrl(2) = REAL(jjm) 84 tab_cntrl(3) = REAL(llm) 85 tab_cntrl(4) = REAL(day_ref) 86 tab_cntrl(5) = REAL(annee_ref) 87 tab_cntrl(6) = rad 88 tab_cntrl(7) = omeg 89 tab_cntrl(8) = g 90 tab_cntrl(9) = cpp 91 tab_cntrl(10) = kappa 92 tab_cntrl(11) = daysec 93 tab_cntrl(12) = dtvr 94 tab_cntrl(13) = etot0 95 tab_cntrl(14) = ptot0 96 tab_cntrl(15) = ztot0 97 tab_cntrl(16) = stot0 98 tab_cntrl(17) = ang0 99 tab_cntrl(18) = pa 100 tab_cntrl(19) = preff 101 c 102 c ..... parametres pour le zoom ...... 103 104 tab_cntrl(20) = clon 105 tab_cntrl(21) = clat 106 tab_cntrl(22) = grossismx 107 tab_cntrl(23) = grossismy 108 c 109 IF ( fxyhypb ) THEN 110 tab_cntrl(24) = 1. 111 tab_cntrl(25) = dzoomx 112 tab_cntrl(26) = dzoomy 113 tab_cntrl(27) = 0. 114 tab_cntrl(28) = taux 115 tab_cntrl(29) = tauy 116 ELSE 117 tab_cntrl(24) = 0. 118 tab_cntrl(25) = dzoomx 119 tab_cntrl(26) = dzoomy 120 tab_cntrl(27) = 0. 121 tab_cntrl(28) = 0. 122 tab_cntrl(29) = 0. 123 IF( ysinus ) tab_cntrl(27) = 1. 124 ENDIF 125 126 tab_cntrl(30) = REAL(iday_end) 127 tab_cntrl(31) = REAL(itau_dyn + itaufin) 128 c start_time: start_time of simulation (not necessarily 0.) 129 tab_cntrl(32) = start_time 130 c 131 c ......................................................... 132 c 133 c Creation du fichier: 134 c 135 ierr = NF_CREATE(fichnom, NF_CLOBBER, nid) 136 IF (ierr.NE.NF_NOERR) THEN 137 write(lunout,*)"dynredem0: Pb d ouverture du fichier " 138 & //trim(fichnom) 139 write(lunout,*)' ierr = ', ierr 140 CALL ABORT_GCM("DYNREDEM0", "", 1) 141 ENDIF 142 c 143 c Preciser quelques attributs globaux: 144 c 145 ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27, 146 . "Fichier demmarage dynamique") 147 c 148 c Definir les dimensions du fichiers: 149 c 150 ierr = NF_DEF_DIM (nid, "index", length, idim_index) 151 ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu) 152 ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu) 153 ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv) 154 ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv) 155 ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s) 156 ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig) 157 ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim) 158 c 159 ierr = NF_ENDDEF(nid) ! sortir du mode de definition 160 c 161 c Definir et enregistrer certains champs invariants: 162 c 163 ierr = NF_REDEF (nid) 164 cIM 220306 BEG 165 #ifdef NC_DOUBLE 166 ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid) 167 #else 168 ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid) 169 #endif 170 cIM 220306 END 171 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, 172 . "Parametres de controle") 173 ierr = NF_ENDDEF(nid) 174 #ifdef NC_DOUBLE 175 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) 176 #else 177 ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl) 178 #endif 179 c 180 ierr = NF_REDEF (nid) 181 cIM 220306 BEG 182 #ifdef NC_DOUBLE 183 ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid) 184 #else 185 ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid) 186 #endif 187 cIM 220306 END 188 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23, 189 . "Longitudes des points U") 190 ierr = NF_ENDDEF(nid) 191 #ifdef NC_DOUBLE 192 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu) 193 #else 194 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu) 195 #endif 196 c 197 ierr = NF_REDEF (nid) 198 cIM 220306 BEG 199 #ifdef NC_DOUBLE 200 ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid) 201 #else 202 ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid) 203 #endif 204 cIM 220306 END 205 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, 206 . "Latitudes des points U") 207 ierr = NF_ENDDEF(nid) 208 #ifdef NC_DOUBLE 209 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu) 210 #else 211 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu) 212 #endif 213 c 214 ierr = NF_REDEF (nid) 215 cIM 220306 BEG 216 #ifdef NC_DOUBLE 217 ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid) 218 #else 219 ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid) 220 #endif 221 cIM 220306 END 222 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23, 223 . "Longitudes des points V") 224 ierr = NF_ENDDEF(nid) 225 #ifdef NC_DOUBLE 226 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv) 227 #else 228 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv) 229 #endif 230 c 231 ierr = NF_REDEF (nid) 232 cIM 220306 BEG 233 #ifdef NC_DOUBLE 234 ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid) 235 #else 236 ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid) 237 #endif 238 cIM 220306 END 239 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, 240 . "Latitudes des points V") 241 ierr = NF_ENDDEF(nid) 242 #ifdef NC_DOUBLE 243 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv) 244 #else 245 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv) 246 #endif 247 c 248 ierr = NF_REDEF (nid) 249 cIM 220306 BEG 250 #ifdef NC_DOUBLE 251 ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid) 252 #else 253 ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid) 254 #endif 255 cIM 220306 END 256 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28, 257 . "Numero naturel des couches s") 258 ierr = NF_ENDDEF(nid) 259 #ifdef NC_DOUBLE 260 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs) 261 #else 262 ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs) 263 #endif 264 c 265 ierr = NF_REDEF (nid) 266 cIM 220306 BEG 267 #ifdef NC_DOUBLE 268 ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid) 269 #else 270 ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid) 271 #endif 272 cIM 220306 END 273 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32, 274 . "Numero naturel des couches sigma") 275 ierr = NF_ENDDEF(nid) 276 #ifdef NC_DOUBLE 277 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig) 278 #else 279 ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig) 280 #endif 281 c 282 ierr = NF_REDEF (nid) 283 cIM 220306 BEG 284 #ifdef NC_DOUBLE 285 ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid) 286 #else 287 ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid) 288 #endif 289 cIM 220306 END 290 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26, 291 . "Coefficient A pour hybride") 292 ierr = NF_ENDDEF(nid) 293 #ifdef NC_DOUBLE 294 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap) 295 #else 296 ierr = NF_PUT_VAR_REAL (nid,nvarid,ap) 297 #endif 298 c 299 ierr = NF_REDEF (nid) 300 cIM 220306 BEG 301 #ifdef NC_DOUBLE 302 ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid) 303 #else 304 ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid) 305 #endif 306 cIM 220306 END 307 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26, 308 . "Coefficient B pour hybride") 309 ierr = NF_ENDDEF(nid) 310 #ifdef NC_DOUBLE 311 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp) 312 #else 313 ierr = NF_PUT_VAR_REAL (nid,nvarid,bp) 314 #endif 315 c 316 ierr = NF_REDEF (nid) 317 cIM 220306 BEG 318 #ifdef NC_DOUBLE 319 ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid) 320 #else 321 ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid) 322 #endif 323 cIM 220306 END 324 ierr = NF_ENDDEF(nid) 325 #ifdef NC_DOUBLE 326 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs) 327 #else 328 ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs) 329 #endif 330 c 331 c Coefficients de passage cov. <-> contra. <--> naturel 332 c 333 ierr = NF_REDEF (nid) 334 dims2(1) = idim_rlonu 335 dims2(2) = idim_rlatu 336 cIM 220306 BEG 337 #ifdef NC_DOUBLE 338 ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid) 339 #else 340 ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid) 341 #endif 342 cIM 220306 END 343 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29, 344 . "Coefficient de passage pour U") 345 ierr = NF_ENDDEF(nid) 346 #ifdef NC_DOUBLE 347 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu) 348 #else 349 ierr = NF_PUT_VAR_REAL (nid,nvarid,cu) 350 #endif 351 c 352 ierr = NF_REDEF (nid) 353 dims2(1) = idim_rlonv 354 dims2(2) = idim_rlatv 355 cIM 220306 BEG 356 #ifdef NC_DOUBLE 357 ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid) 358 #else 359 ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid) 360 #endif 361 cIM 220306 END 362 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29, 363 . "Coefficient de passage pour V") 364 ierr = NF_ENDDEF(nid) 365 #ifdef NC_DOUBLE 366 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv) 367 #else 368 ierr = NF_PUT_VAR_REAL (nid,nvarid,cv) 369 #endif 370 c 371 c Aire de chaque maille: 372 c 373 ierr = NF_REDEF (nid) 374 dims2(1) = idim_rlonv 375 dims2(2) = idim_rlatu 376 cIM 220306 BEG 377 #ifdef NC_DOUBLE 378 ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid) 379 #else 380 ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid) 381 #endif 382 cIM 220306 END 383 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, 384 . "Aires de chaque maille") 385 ierr = NF_ENDDEF(nid) 386 #ifdef NC_DOUBLE 387 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire) 388 #else 389 ierr = NF_PUT_VAR_REAL (nid,nvarid,aire) 390 #endif 391 c 392 c Geopentiel au sol: 393 c 394 ierr = NF_REDEF (nid) 395 dims2(1) = idim_rlonv 396 dims2(2) = idim_rlatu 397 cIM 220306 BEG 398 #ifdef NC_DOUBLE 399 ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid) 400 #else 401 ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid) 402 #endif 403 cIM 220306 END 404 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19, 405 . "Geopotentiel au sol") 406 ierr = NF_ENDDEF(nid) 407 #ifdef NC_DOUBLE 408 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis_glo) 409 #else 410 ierr = NF_PUT_VAR_REAL (nid,nvarid,phis_glo) 411 #endif 412 c 413 c Definir les variables pour pouvoir les enregistrer plus tard: 414 c 415 ierr = NF_REDEF (nid) ! entrer dans le mode de definition 416 c 417 cIM 220306 BEG 418 #ifdef NC_DOUBLE 419 ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid) 420 #else 421 ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid) 422 #endif 423 cIM 220306 END 424 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19, 425 . "Temps de simulation") 426 write(unites,200)yyears0,mmois0,jjour0 427 200 format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00') 428 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30, 429 . unites) 430 431 c 432 dims4(1) = idim_rlonu 433 dims4(2) = idim_rlatu 434 dims4(3) = idim_s 435 dims4(4) = idim_tim 436 cIM 220306 BEG 437 #ifdef NC_DOUBLE 438 ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid) 439 #else 440 ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid) 441 #endif 442 cIM 220306 END 443 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9, 444 . "Vitesse U") 445 c 446 dims4(1) = idim_rlonv 447 dims4(2) = idim_rlatv 448 dims4(3) = idim_s 449 dims4(4) = idim_tim 450 cIM 220306 BEG 451 #ifdef NC_DOUBLE 452 ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid) 453 #else 454 ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid) 455 #endif 456 cIM 220306 END 457 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9, 458 . "Vitesse V") 459 c 460 dims4(1) = idim_rlonv 461 dims4(2) = idim_rlatu 462 dims4(3) = idim_s 463 dims4(4) = idim_tim 464 cIM 220306 BEG 465 #ifdef NC_DOUBLE 466 ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid) 467 #else 468 ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid) 469 #endif 470 cIM 220306 END 471 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11, 472 . "Temperature") 473 c 474 dims4(1) = idim_rlonv 475 dims4(2) = idim_rlatu 476 dims4(3) = idim_s 477 dims4(4) = idim_tim 478 479 DO iq=1,nqtot 480 cIM 220306 BEG 481 #ifdef NC_DOUBLE 482 ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid) 483 #else 484 ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid) 485 #endif 486 cIM 220306 END 487 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq)) 488 ENDDO 489 c 490 dims4(1) = idim_rlonv 491 dims4(2) = idim_rlatu 492 dims4(3) = idim_s 493 dims4(4) = idim_tim 494 cIM 220306 BEG 495 #ifdef NC_DOUBLE 496 ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid) 497 #else 498 ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid) 499 #endif 500 cIM 220306 END 501 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12, 502 . "C est quoi ?") 503 c 504 dims3(1) = idim_rlonv 505 dims3(2) = idim_rlatu 506 dims3(3) = idim_tim 507 cIM 220306 BEG 508 #ifdef NC_DOUBLE 509 ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid) 510 #else 511 ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid) 512 #endif 513 cIM 220306 END 514 ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15, 515 . "Pression au sol") 516 c 517 ierr = NF_ENDDEF(nid) ! sortir du mode de definition 518 ierr = NF_CLOSE(nid) ! fermer le fichier 519 520 write(lunout,*)'dynredem_loc: iim,jjm,llm,iday_end', 521 & iim,jjm,llm,iday_end 522 write(lunout,*)'dynredem_loc: rad,omeg,g,cpp,kappa', 523 & rad,omeg,g,cpp,kappa 524 525 endif ! mpi_rank==0 526 RETURN 527 END 528 SUBROUTINE dynredem1_loc(fichnom,time, 529 . vcov,ucov,teta,q,masse,ps) 530 USE parallel_lmdz 531 USE mod_hallo 532 USE infotrac 533 USE control_mod 534 USE dynredem_mod 535 IMPLICIT NONE 536 c================================================================= 537 c Ecriture du fichier de redemarrage sous format NetCDF 538 c================================================================= 539 #include "dimensions.h" 540 #include "paramet.h" 541 #include "description.h" 542 #include "netcdf.inc" 543 #include "comvert.h" 544 #include "comgeom.h" 545 #include "temps.h" 546 #include "iniprint.h" 547 548 INTEGER l 549 REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm) 550 REAL teta(ijb_u:ije_u,llm) 551 REAL ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm) 552 REAL q(ijb_u:ije_u,llm,nqtot) 553 CHARACTER*(*) fichnom 554 555 REAL time 556 INTEGER nid, nvarid, nid_trac, nvarid_trac 557 REAL trac_tmp(ijb_u:ije_u,llm) 558 INTEGER ierr, ierr_file 559 INTEGER iq 560 INTEGER length 561 PARAMETER (length = 100) 562 REAL tab_cntrl(length) ! tableau des parametres du run 563 character*20 modname 564 character*80 abort_message 565 c 566 INTEGER nb 567 SAVE nb 568 DATA nb / 0 / 569 REAL,SAVE,ALLOCATABLE :: ucov_glo(:,:),vcov_glo(:,:),teta_glo(:,:) 570 REAL,SAVE,ALLOCATABLE :: masse_glo(:,:),ps_glo(:),q_glo(:,:) 571 LOGICAL,SAVE :: exist_file 572 INTEGER,SAVE :: ierr_var 573 574 ! call Gather_Field(ucov,ip1jmp1,llm,0) 575 ! call Gather_Field(vcov,ip1jm,llm,0) 576 ! call Gather_Field(teta,ip1jmp1,llm,0) 577 ! call Gather_Field(masse,ip1jmp1,llm,0) 578 ! call Gather_Field(ps,ip1jmp1,1,0) 579 580 ! do iq=1,nqtot 581 ! call Gather_Field(q(1,1,iq),ip1jmp1,llm,0) 582 ! enddo 583 55 yyears0=0 56 mmois0=1 57 jjour0=1 58 #endif 59 60 tab_cntrl(:) = 0. 61 tab_cntrl(1) = REAL(iim) 62 tab_cntrl(2) = REAL(jjm) 63 tab_cntrl(3) = REAL(llm) 64 tab_cntrl(4) = REAL(day_ref) 65 tab_cntrl(5) = REAL(annee_ref) 66 tab_cntrl(6) = rad 67 tab_cntrl(7) = omeg 68 tab_cntrl(8) = g 69 tab_cntrl(9) = cpp 70 tab_cntrl(10) = kappa 71 tab_cntrl(11) = daysec 72 tab_cntrl(12) = dtvr 73 tab_cntrl(13) = etot0 74 tab_cntrl(14) = ptot0 75 tab_cntrl(15) = ztot0 76 tab_cntrl(16) = stot0 77 tab_cntrl(17) = ang0 78 tab_cntrl(18) = pa 79 tab_cntrl(19) = preff 80 81 ! ..... parameters for zoom ...... 82 tab_cntrl(20) = clon 83 tab_cntrl(21) = clat 84 tab_cntrl(22) = grossismx 85 tab_cntrl(23) = grossismy 86 ! 87 IF ( fxyhypb ) THEN 88 tab_cntrl(24) = 1. 89 tab_cntrl(25) = dzoomx 90 tab_cntrl(26) = dzoomy 91 tab_cntrl(27) = 0. 92 tab_cntrl(28) = taux 93 tab_cntrl(29) = tauy 94 ELSE 95 tab_cntrl(24) = 0. 96 tab_cntrl(25) = dzoomx 97 tab_cntrl(26) = dzoomy 98 tab_cntrl(27) = 0. 99 tab_cntrl(28) = 0. 100 tab_cntrl(29) = 0. 101 IF( ysinus ) tab_cntrl(27) = 1. 102 END IF 103 tab_cntrl(30) = REAL(iday_end) 104 tab_cntrl(31) = REAL(itau_dyn + itaufin) 105 ! start_time: start_time of simulation (not necessarily 0.) 106 tab_cntrl(32) = start_time 107 108 !--- File creation 109 CALL err(NF90_CREATE(fichnom,NF90_CLOBBER,nid)) 110 111 !--- Some global attributes 112 CALL err(NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier demarrage dynamique")) 113 114 !--- Dimensions 115 CALL err(NF90_DEF_DIM(nid,"index", length, indexID)) 116 CALL err(NF90_DEF_DIM(nid,"rlonu", iip1, rlonuID)) 117 CALL err(NF90_DEF_DIM(nid,"rlatu", jjp1, rlatuID)) 118 CALL err(NF90_DEF_DIM(nid,"rlonv", iip1, rlonvID)) 119 CALL err(NF90_DEF_DIM(nid,"rlatv", jjm, rlatvID)) 120 CALL err(NF90_DEF_DIM(nid,"sigs", llm, sID)) 121 CALL err(NF90_DEF_DIM(nid,"sig", llmp1, sigID)) 122 CALL err(NF90_DEF_DIM(nid,"temps", NF90_UNLIMITED, timID)) 123 124 !--- Define and save invariant fields 125 CALL put_var(nid,"controle","Parametres de controle" ,[indexID],tab_cntrl) 126 CALL put_var(nid,"rlonu" ,"Longitudes des points U",[rlonuID],rlonu) 127 CALL put_var(nid,"rlatu" ,"Latitudes des points U" ,[rlatuID],rlatu) 128 CALL put_var(nid,"rlonv" ,"Longitudes des points V",[rlonvID],rlonv) 129 CALL put_var(nid,"rlatv" ,"Latitudes des points V" ,[rlatvID],rlatv) 130 CALL put_var(nid,"nivsigs" ,"Numero naturel des couches s" ,[sID] ,nivsigs) 131 CALL put_var(nid,"nivsig" ,"Numero naturel des couches sigma",[sigID],nivsig) 132 CALL put_var(nid,"ap" ,"Coefficient A pour hybride" ,[sigID],ap) 133 CALL put_var(nid,"bp" ,"Coefficient B pour hybride" ,[sigID],bp) 134 CALL put_var(nid,"presnivs","" ,[sID] ,presnivs) 135 ! covariant <-> contravariant <-> natural conversion coefficients 136 CALL put_var(nid,"cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu) 137 CALL put_var(nid,"cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv) 138 CALL put_var(nid,"aire","Aires de chaque maille" ,[rlonvID,rlatuID],aire) 139 CALL put_var(nid,"phisinit","Geopotentiel au sol" ,[rlonvID,rlatuID],phis_glo) 140 141 !--- Define fields saved later 142 WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')"),& 143 yyears0,mmois0,jjour0 144 CALL cre_var(nid,"temps","Temps de simulation",[timID],unites) 145 CALL cre_var(nid,"ucov" ,"Vitesse U" ,[rlonuID,rlatuID,sID,timID]) 146 CALL cre_var(nid,"vcov" ,"Vitesse V" ,[rlonvID,rlatvID,sID,timID]) 147 CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID]) 148 DO iq=1,nqtot 149 CALL cre_var(nid,tname(iq),ttext(iq),[rlonvID,rlatuID,sID,timID]) 150 END DO 151 CALL cre_var(nid,"masse","Masse d air" ,[rlonvID,rlatuID,sID,timID]) 152 CALL cre_var(nid,"ps" ,"Pression au sol",[rlonvID,rlatuID ,timID]) 153 CALL err(NF90_CLOSE (nid)) 154 155 WRITE(lunout,*)TRIM(modname)//': iim,jjm,llm,iday_end',iim,jjm,llm,iday_end 156 WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa 157 158 END SUBROUTINE dynredem0_loc 159 ! 160 !------------------------------------------------------------------------------- 161 162 163 !------------------------------------------------------------------------------- 164 ! 165 SUBROUTINE dynredem1_loc(fichnom,time,vcov,ucov,teta,q,masse,ps) 166 ! 167 !------------------------------------------------------------------------------- 168 ! Purpose: Write the NetCDF restart file (append). 169 !------------------------------------------------------------------------------- 170 USE parallel_lmdz 171 USE mod_hallo 172 USE infotrac 173 USE control_mod 174 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID, & 175 NF90_CLOSE, NF90_WRITE, NF90_PUT_VAR, NF90_NoErr 176 USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, & 177 err, modname, fil, msg 178 IMPLICIT NONE 179 include "dimensions.h" 180 include "paramet.h" 181 include "description.h" 182 include "comvert.h" 183 include "comgeom.h" 184 include "temps.h" 185 include "iniprint.h" 186 !=============================================================================== 187 ! Arguments: 188 CHARACTER(LEN=*), INTENT(IN) :: fichnom !-- FILE NAME 189 REAL, INTENT(IN) :: time !-- TIME 190 REAL, INTENT(IN) :: vcov(ijb_v:ije_v,llm) !-- V COVARIANT WIND 191 REAL, INTENT(IN) :: ucov(ijb_u:ije_u,llm) !-- U COVARIANT WIND 192 REAL, INTENT(IN) :: teta(ijb_u:ije_u,llm) !-- POTENTIAL TEMPERATURE 193 REAL, INTENT(INOUT) :: q(ijb_u:ije_u,llm,nqtot) !-- TRACERS 194 REAL, INTENT(IN) :: masse(ijb_u:ije_u,llm) !-- MASS PER CELL 195 REAL, INTENT(IN) :: ps(ijb_u:ije_u) !-- GROUND PRESSURE 196 !=============================================================================== 197 ! Local variables: 198 INTEGER :: l, iq, nid, vID, ierr, nid_trac, vID_trac 199 INTEGER, SAVE :: nb=0 200 INTEGER, PARAMETER :: length=100 201 REAL :: tab_cntrl(length) ! tableau des parametres du run 202 CHARACTER(LEN=256) :: var, dum 203 LOGICAL :: lread_inca 204 !=============================================================================== 205 206 !$OMP MASTER 207 IF(mpi_rank==0) THEN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 208 modname='dynredem1_loc'; fil=fichnom 209 fil=fichnom 210 CALL err(NF90_OPEN(fil,NF90_WRITE,nid),"open",fil) 211 212 !--- Write/extend time coordinate 213 nb = nb + 1 214 var="temps" 215 CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var) 216 CALL err(NF90_PUT_VAR(nid,vID,[time]),"put",var) 217 WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time 218 219 !--- Rewrite control table (itaufin undefined in dynredem0) 220 var="controle" 221 CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var) 222 CALL err(NF90_GET_VAR(nid,vID,tab_cntrl),"get",var) 223 tab_cntrl(31)=DBLE(itau_dyn + itaufin) 224 CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var) 225 CALL err(NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var) 226 END IF !++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 227 !$OMP END MASTER 228 229 !--- Save fields 230 CALL dynredem_write_u(nid,"ucov" ,ucov ,llm) 231 CALL dynredem_write_v(nid,"vcov" ,vcov ,llm) 232 CALL dynredem_write_u(nid,"teta" ,teta ,llm) 233 CALL dynredem_write_u(nid,"masse",masse,llm) 234 CALL dynredem_write_u(nid,"ps" ,ps ,1) 235 236 !--- Tracers in file "start_trac.nc" (added by Anne) 237 !$OMP MASTER 238 lread_inca=.FALSE.; fil="start_trac.nc" 239 IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca) 240 IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open") 241 !$OMP END MASTER 242 !$OMP BARRIER 243 244 !--- Save tracers 245 DO iq=1,nqtot; var=tname(iq); ierr=-1 246 IF(lread_inca) THEN !--- Possibly read from "start_trac.nc" 584 247 !$OMP MASTER 585 if (mpi_rank==0) then 586 modname = 'dynredem1_loc' 587 ierr = NF_OPEN(fichnom, NF_WRITE, nid) 588 IF (ierr .NE. NF_NOERR) THEN 589 write(lunout,*)"dynredem1: Pb. d ouverture "//trim(fichnom) 590 CALL abort_gcm("dynredem1", "", 1) 591 ENDIF 592 593 c Ecriture/extension de la coordonnee temps 594 595 nb = nb + 1 596 ierr = NF_INQ_VARID(nid, "temps", nvarid) 597 IF (ierr .NE. NF_NOERR) THEN 598 write(lunout,*) NF_STRERROR(ierr) 599 abort_message='Variable temps n est pas definie' 600 CALL abort_gcm(modname,abort_message,ierr) 601 ENDIF 602 #ifdef NC_DOUBLE 603 ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time) 604 #else 605 ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time) 606 #endif 607 write(lunout,*) "dynredem1_loc: Enregistrement pour ", nb, time 608 609 c 610 c Re-ecriture du tableau de controle, itaufin n'est plus defini quand 611 c on passe dans dynredem0 612 ierr = NF_INQ_VARID (nid, "controle", nvarid) 613 IF (ierr .NE. NF_NOERR) THEN 614 abort_message="dynredem1: Le champ <controle> est absent" 615 ierr = 1 616 CALL abort_gcm(modname,abort_message,ierr) 617 ENDIF 618 #ifdef NC_DOUBLE 619 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl) 620 #else 621 ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl) 622 #endif 623 tab_cntrl(31) = REAL(itau_dyn + itaufin) 624 #ifdef NC_DOUBLE 625 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) 626 #else 627 ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl) 628 #endif 629 endif 630 !$OMP END MASTER 631 632 ! 633 CALL dynredem_write_u(nid,"ucov",ucov,llm) 634 CALL dynredem_write_v(nid,"vcov",vcov,llm) 635 CALL dynredem_write_u(nid,"teta",teta,llm) 636 CALL dynredem_write_u(nid,"masse",masse,llm) 637 CALL dynredem_write_u(nid,"ps",ps,1) 638 639 IF (type_trac /= 'inca') THEN 640 DO iq=1,nqtot 641 CALL dynredem_write_u(nid,tname(iq),q(:,:,iq),llm) 642 ENDDO 643 ELSE 644 248 fil="start_trac.nc" 249 ierr=NF90_INQ_VARID(nid_trac,var,vID_trac) 250 dum='inq'; IF(ierr==NF90_NoErr) dum='fnd' 251 WRITE(lunout,*)msg(dum,var) 252 !$OMP END MASTER 253 !$OMP BARRIER 254 IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,iq),llm) 255 END IF 256 fil=fichnom 257 CALL dynredem_write_u(nid,var,q(:,:,iq),llm) 258 END DO 259 645 260 !$OMP MASTER 646 INQUIRE(FILE="start_trac.nc", EXIST=exist_file) 647 PRINT *, "EXIST", exist_file 648 !$OMP END MASTER 649 !$OMP BARRIER 650 651 IF (exist_file) THEN 652 !$OMP MASTER 653 ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac) 654 IF (ierr_file .NE.NF_NOERR) THEN 655 WRITE(6,*)' Pb d''ouverture du fichier start_trac.nc' 656 WRITE(6,*)' ierr = ', ierr_file 657 ENDIF 658 !$OMP END MASTER 659 660 DO iq=1,nqtot 661 662 !$OMP MASTER 663 ierr_var = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac) 664 !$OMP END MASTER 665 !$OMP BARRIER 666 IF (ierr == NF_NOERR) THEN 667 CALL dynredem_read_u(nid_trac,tname(iq),q(:,:,iq),llm) 668 ENDIF 669 CALL dynredem_write_u(nid,tname(iq),q(:,:,iq),llm) 670 ENDDO 671 672 ELSE ! pas de fichier start_tract 673 DO iq=1,nqtot 674 CALL dynredem_write_u(nid,tname(iq),q(:,:,iq),llm) 675 ENDDO 676 ENDIF 677 ENDIF 678 679 680 !$OMP MASTER 681 IF (mpi_rank==0) THEN 682 ierr = NF_CLOSE(nid) 683 ENDIF ! mpi_rank==0 684 !$OMP END MASTER 685 686 RETURN 687 END 688 261 IF(mpi_rank==0) THEN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 262 CALL err(NF90_CLOSE(nid),"close") 263 fil="start_trac.nc" 264 IF(lread_inca) CALL err(NF90_CLOSE(nid_trac),"close") 265 END IF !++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 266 !$OMP END MASTER 267 268 END SUBROUTINE dynredem1_loc 269 -
LMDZ5/trunk/libf/dyn3dmem/dynredem_mod.F90
r1907 r2299 1 !2 ! $Id$3 !4 1 MODULE dynredem_mod 5 2 6 CONTAINS7 8 SUBROUTINE dynredem_write_u(ncid,id,var,ll)9 3 USE dimensions_mod 10 4 USE parallel_lmdz 11 5 USE mod_hallo 12 IMPLICIT NONE 13 INTEGER :: ncid 14 CHARACTER(LEN=*) :: id 15 REAL :: var(ijb_u:ije_u,ll) 16 REAL,ALLOCATABLE,SAVE :: var_tmp(:,:) 17 REAL,ALLOCATABLE,SAVE :: var_glo(:) 18 INTEGER :: ll 19 INTEGER :: count(4) 20 INTEGER :: start(4) 21 INTEGER :: l 22 INTEGER :: nvarid 23 INTEGER :: ierr 24 INCLUDE 'netcdf.inc' 6 USE netcdf 7 PRIVATE 8 PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err 9 PUBLIC :: cre_var, get_var1, put_var, fil, modname, msg 10 CHARACTER(LEN=256), SAVE :: fil, modname 11 INTEGER, SAVE :: nvarid 12 13 14 CONTAINS 15 16 17 !=============================================================================== 18 ! 19 SUBROUTINE dynredem_write_u(ncid,id,var,ll) 20 ! 21 !=============================================================================== 22 IMPLICIT NONE 23 !=============================================================================== 24 ! Arguments: 25 INTEGER, INTENT(IN) :: ncid 26 CHARACTER(LEN=*), INTENT(IN) :: id 27 REAL, INTENT(IN) :: var(ijb_u:ije_u,ll) 28 INTEGER, INTENT(IN) :: ll 29 !=============================================================================== 30 ! Local variables: 31 REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:) 32 INTEGER :: start(4), count(4), l, ierr 33 !=============================================================================== 34 start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,1,1] 35 36 !$OMP MASTER 37 IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id) 38 !$OMP END MASTER 39 40 !$OMP MASTER 41 ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1)) 42 !$OMP END MASTER 43 !$OMP BARRIER 44 45 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 46 DO l=1,ll; var_tmp(:,l)=var(:,l); END DO 47 DO l=1,ll 48 CALL gather_field_u(var_tmp(:,l),var_glo,1) 49 IF(mpi_rank==0) THEN 50 !$OMP MASTER 51 start(3)=l 52 CALL err(NF90_PUT_VAR(ncid,nvarid,var_glo,start,count),"put",id) 53 !$OMP END MASTER 54 END IF 55 END DO 56 !$OMP BARRIER 57 !$OMP MASTER 58 DEALLOCATE(var_glo,var_tmp) 59 !$OMP END MASTER 60 !$OMP BARRIER 61 62 END SUBROUTINE dynredem_write_u 63 ! 64 !=============================================================================== 65 66 67 !=============================================================================== 68 ! 69 SUBROUTINE dynredem_write_v(ncid,id,var,ll) 70 ! 71 !=============================================================================== 72 IMPLICIT NONE 73 !=============================================================================== 74 ! Arguments: 75 INTEGER, INTENT(IN) :: ncid 76 CHARACTER(LEN=*), INTENT(IN) :: id 77 REAL, INTENT(IN) :: var(ijb_v:ije_v,ll) 78 INTEGER, INTENT(IN) :: ll 79 !=============================================================================== 80 ! Local variables: 81 REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:) 82 INTEGER :: start(4), count(4), l, ierr 83 !=============================================================================== 84 start(:)=[1,1,1,1]; count(:)=[iip1,jjm,1,1] 85 86 !$OMP MASTER 87 IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id) 88 !$OMP END MASTER 89 90 !$OMP MASTER 91 ALLOCATE(var_tmp(ijb_v:ije_v,ll),var_glo(ip1jm)) 92 !$OMP END MASTER 93 !$OMP BARRIER 94 95 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 96 DO l=1,ll; var_tmp(:,l)=var(:,l); END DO 97 DO l=1,ll 98 CALL gather_field_v(var_tmp(:,l),var_glo,1) 99 IF(mpi_rank==0) THEN 100 !$OMP MASTER 101 start(3)=l 102 CALL err(NF90_PUT_VAR(ncid,nvarid,var_glo,start,count),"put",id) 103 !$OMP END MASTER 104 END IF 105 END DO 106 !$OMP BARRIER 107 !$OMP MASTER 108 DEALLOCATE(var_glo,var_tmp) 109 !$OMP END MASTER 110 !$OMP BARRIER 111 112 END SUBROUTINE dynredem_write_v 113 ! 114 !=============================================================================== 115 116 117 !=============================================================================== 118 ! 119 SUBROUTINE dynredem_read_u(ncid,id,var,ll) 120 ! 121 !=============================================================================== 122 IMPLICIT NONE 123 !=============================================================================== 124 ! Arguments: 125 INTEGER, INTENT(IN) :: ncid 126 CHARACTER(LEN=*), INTENT(IN) :: id 127 REAL, INTENT(OUT) :: var(ijb_u:ije_u,ll) 128 INTEGER, INTENT(IN) :: ll 129 !=============================================================================== 130 ! Local variables: 131 REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:) 132 INTEGER :: start(4), count(4), l, ierr 133 !=============================================================================== 134 start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,1,1] 135 136 !$OMP MASTER 137 IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),'inq',id) 138 !$OMP END MASTER 139 140 !$OMP MASTER 141 ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1)) 142 !$OMP END MASTER 143 !$OMP BARRIER 144 145 DO l=1,ll 146 IF(mpi_rank==0) THEN 147 !$OMP MASTER 148 start(3)=l 149 CALL err(NF90_GET_VAR(ncid,nvarid,var_glo,start,count),"get",id) 150 !$OMP END MASTER 151 END IF 152 CALL scatter_field_u(var_glo,var_tmp(:,l),1) 153 END DO 154 155 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 156 DO l=1,ll; var(:,l)=var_tmp(:,l); END DO 25 157 26 count(:)=(/ iip1,jjp1,1,1 /) 27 start(:)=(/ 1,1,1,1 /) 28 29 !$OMP MASTER 30 IF (mpi_rank==0) THEN 31 ierr = NF_INQ_VARID(ncid, id, nvarid) 32 IF (ierr .NE. NF_NOERR) THEN 33 PRINT*, "Variable "//id//" n est pas definie" 34 CALL abort 35 ENDIF 36 ENDIF 37 !$OMP END MASTER 38 39 !$OMP MASTER 40 ALLOCATE(var_tmp(ijb_u:ije_u,ll)) 41 ALLOCATE(var_glo(ip1jmp1)) 42 !$OMP END MASTER 43 !$OMP BARRIER 44 45 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 46 DO l=1,ll 47 var_tmp(:,l)=var(:,l) 48 ENDDO 49 50 DO l=1,ll 51 CALL gather_field_u(var_tmp(:,l),var_glo,1) 52 IF (mpi_rank==0) THEN 53 !$OMP MASTER 54 start(3)=l 158 !$OMP BARRIER 159 !$OMP MASTER 160 DEALLOCATE(var_glo,var_tmp) 161 !$OMP END MASTER 162 !$OMP BARRIER 163 164 END SUBROUTINE dynredem_read_u 165 ! 166 !=============================================================================== 167 168 169 !=============================================================================== 170 ! 171 SUBROUTINE cre_var(ncid,var,title,did,units) 172 ! 173 !=============================================================================== 174 IMPLICIT NONE 175 !=============================================================================== 176 ! Arguments: 177 INTEGER, INTENT(IN) :: ncid 178 CHARACTER(LEN=*), INTENT(IN) :: var, title 179 INTEGER, INTENT(IN) :: did(:) 180 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units 181 !=============================================================================== 55 182 #ifdef NC_DOUBLE 56 ierr = NF_PUT_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)183 CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var) 57 184 #else 58 ierr = NF_PUT_VARA_REAL (ncid,nvarid,start,count,var_glo)185 CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var) 59 186 #endif 60 !$OMP END MASTER 61 ENDIF 62 ENDDO 63 64 !$OMP BARRIER 65 !$OMP MASTER 66 DEALLOCATE(var_tmp) 67 DEALLOCATE(var_glo) 68 !$OMP END MASTER 69 !$OMP BARRIER 70 71 END SUBROUTINE dynredem_write_u 72 73 SUBROUTINE dynredem_write_v(ncid,id,var,ll) 74 USE dimensions_mod 75 USE parallel_lmdz 76 USE mod_hallo 77 IMPLICIT NONE 78 INTEGER :: ncid 79 CHARACTER(LEN=*) :: id 80 REAL :: var(ijb_v:ije_v,ll) 81 REAL,ALLOCATABLE,SAVE :: var_tmp(:,:) 82 REAL,ALLOCATABLE,SAVE :: var_glo(:) 83 INTEGER :: ll 84 INTEGER :: count(4) 85 INTEGER :: start(4) 86 INTEGER :: l 87 INTEGER :: nvarid 88 INTEGER :: ierr 89 INCLUDE 'netcdf.inc' 90 91 count(:)=(/ iip1,jjm,1,1 /) 92 start(:)=(/ 1,1,1,1 /) 93 94 !$OMP MASTER 95 IF (mpi_rank==0) THEN 96 ierr = NF_INQ_VARID(ncid, id, nvarid) 97 IF (ierr .NE. NF_NOERR) THEN 98 PRINT*, "Variable "//id//" n est pas definie" 99 CALL abort 100 ENDIF 101 ENDIF 102 !$OMP END MASTER 103 104 !$OMP MASTER 105 ALLOCATE(var_tmp(ijb_v:ije_v,ll)) 106 ALLOCATE(var_glo(ip1jm)) 107 !$OMP END MASTER 108 !$OMP BARRIER 109 110 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 111 DO l=1,ll 112 var_tmp(:,l)=var(:,l) 113 ENDDO 114 115 DO l=1,ll 116 CALL gather_field_v(var_tmp(:,l),var_glo,1) 117 IF (mpi_rank==0) THEN 118 !$OMP MASTER 119 start(3)=l 120 #ifdef NC_DOUBLE 121 ierr = NF_PUT_VARA_DOUBLE (ncid,nvarid,start,count,var_glo) 122 #else 123 ierr = NF_PUT_VARA_REAL (ncid,nvarid,start,count,var_glo) 124 #endif 125 !$OMP END MASTER 126 ENDIF 127 ENDDO 128 129 !$OMP BARRIER 130 !$OMP MASTER 131 DEALLOCATE(var_tmp) 132 DEALLOCATE(var_glo) 133 !$OMP END MASTER 134 !$OMP BARRIER 135 136 END SUBROUTINE dynredem_write_v 137 138 SUBROUTINE dynredem_read_u(ncid,id,var,ll) 139 USE dimensions_mod 140 USE parallel_lmdz 141 USE mod_hallo 142 IMPLICIT NONE 143 INTEGER :: ncid 144 CHARACTER(LEN=*) :: id 145 REAL :: var(ijb_u:ije_u,ll) 146 REAL,ALLOCATABLE,SAVE :: var_tmp(:,:) 147 REAL,ALLOCATABLE,SAVE :: var_glo(:) 148 INTEGER :: ll 149 INTEGER :: count(4) 150 INTEGER :: start(4) 151 INTEGER :: l 152 INTEGER :: nvarid 153 INTEGER :: ierr 154 INCLUDE 'netcdf.inc' 155 156 count(:)=(/ iip1,jjp1,1,1 /) 157 start(:)=(/ 1,1,1,1 /) 158 159 !$OMP MASTER 160 IF (mpi_rank==0) THEN 161 ierr = NF_INQ_VARID(ncid, id, nvarid) 162 IF (ierr .NE. NF_NOERR) THEN 163 PRINT*, "Variable "//id//" n est pas definie" 164 CALL abort 165 ENDIF 166 ENDIF 167 !$OMP END MASTER 168 169 !$OMP MASTER 170 ALLOCATE(var_tmp(ijb_u:ije_u,ll)) 171 ALLOCATE(var_glo(ip1jmp1)) 172 !$OMP END MASTER 173 !$OMP BARRIER 174 175 176 DO l=1,ll 177 IF (mpi_rank==0) THEN 178 !$OMP MASTER 179 start(3)=l 180 #ifdef NC_DOUBLE 181 ierr = NF_GET_VARA_DOUBLE (ncid,nvarid,start,count,var_glo) 182 #else 183 ierr = NF_GET_VARA_REAL (ncid,nvarid,start,count,var_glo) 184 #endif 185 !$OMP END MASTER 186 ENDIF 187 CALL scatter_field_u(var_glo,var_tmp(:,l),1) 188 ENDDO 189 190 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 191 DO l=1,ll 192 var(:,l)=var_tmp(:,l) 193 ENDDO 194 195 !$OMP BARRIER 196 !$OMP MASTER 197 DEALLOCATE(var_tmp) 198 DEALLOCATE(var_glo) 199 !$OMP END MASTER 200 !$OMP BARRIER 201 202 END SUBROUTINE dynredem_read_u 203 187 IF(title/="") CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var) 188 IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var) 189 190 END SUBROUTINE cre_var 191 ! 192 !=============================================================================== 193 194 195 !=============================================================================== 196 ! 197 SUBROUTINE put_var(ncid,var,title,did,v,units) 198 ! 199 !=============================================================================== 200 IMPLICIT NONE 201 !=============================================================================== 202 ! Arguments: 203 INTEGER, INTENT(IN) :: ncid 204 CHARACTER(LEN=*), INTENT(IN) :: var, title 205 INTEGER, INTENT(IN) :: did(:) 206 REAL, INTENT(IN) :: v(:) 207 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units 208 !=============================================================================== 209 INTEGER :: nd, k, nn(2) 210 IF( PRESENT(units)) CALL cre_var(ncid,var,title,did,units) 211 IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did) 212 CALL err(NF90_ENDDEF(ncid)) 213 nd=SIZE(did) 214 DO k=1,nd; CALL err(NF90_INQUIRE_DIMENSION(ncid,did(k),len=nn(k))); END DO 215 IF(nd==1) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:1))),var) 216 IF(nd==2) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:2))),var) 217 CALL err(NF90_REDEF(ncid)) 218 END SUBROUTINE put_var 219 ! 220 !=============================================================================== 221 222 223 !=============================================================================== 224 ! 225 FUNCTION msg(typ,nam) 226 ! 227 !=============================================================================== 228 IMPLICIT NONE 229 !=============================================================================== 230 ! Arguments: 231 CHARACTER(LEN=256) :: msg !--- STANDARDIZED MESSAGE 232 CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION 233 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam !--- FIELD NAME 234 !=============================================================================== 235 SELECT CASE(typ) 236 CASE('open'); msg="Opening failed for <"//TRIM(fil)//">" 237 CASE('close'); msg="Closing failed for <"//TRIM(fil)//">" 238 CASE('get'); msg="Reading failed for <"//TRIM(nam)//">" 239 CASE('put'); msg="Writting failed for <"//TRIM(nam)//">" 240 CASE('inq'); msg="Missing field <"//TRIM(nam)//">" 241 CASE('fnd'); msg="Found field <"//TRIM(nam)//">" 242 END SELECT 243 msg=TRIM(msg)//" in file <"//TRIM(fil)//">" 244 245 END FUNCTION msg 246 ! 247 !=============================================================================== 248 249 250 !=============================================================================== 251 ! 252 SUBROUTINE err(ierr,typ,nam) 253 ! 254 !=============================================================================== 255 IMPLICIT NONE 256 !=============================================================================== 257 ! Arguments: 258 INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE 259 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ !--- TYPE OF OPERATION 260 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam !--- FIELD NAME 261 !=============================================================================== 262 IF(ierr==NF90_NoERR) RETURN 263 IF(.NOT.PRESENT(typ)) THEN 264 CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr) 265 ELSE 266 CALL ABORT_gcm(modname,msg(typ,nam),ierr) 267 END IF 268 269 END SUBROUTINE err 270 ! 271 !=============================================================================== 272 204 273 END MODULE dynredem_mod 274 205 275 206 276
Note: See TracChangeset
for help on using the changeset viewer.
