Changeset 1669 for LMDZ5/branches/testing/libf/dyn3d
- Timestamp:
- Oct 16, 2012, 2:41:50 PM (12 years ago)
- Location:
- LMDZ5/branches/testing
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/testing
- Property svn:mergeinfo changed
/LMDZ5/trunk merged: 1629-1633,1635,1637-1659,1666-1668
- Property svn:mergeinfo changed
-
LMDZ5/branches/testing/libf/dyn3d/calfis.F
r1665 r1669 179 179 ! REAL rdayvrai 180 180 REAL, intent(in):: jD_cur, jH_cur 181 182 LOGICAL tracerdyn 183 181 184 c 182 185 c----------------------------------------------------------------------- … … 459 462 zdqfic(:,:,:)=0. 460 463 461 if (planet_type=="earth") then462 464 #ifdef CPP_PHYS 463 465 … … 467 469 debut_split=debut.and.isplit==1 468 470 lafin_split=lafin.and.isplit==nsplit_phys 471 472 if (planet_type=="earth") then 469 473 470 474 CALL physiq (ngridmx, … … 495 499 . PVteta) 496 500 501 else if ( planet_type=="generic" ) then 502 503 CALL physiq (ngridmx, !! ngrid 504 . llm, !! nlayer 505 . nqtot, !! nq 506 . tname, !! tracer names from dynamical core (given in infotrac) 507 . debut_split, !! firstcall 508 . lafin_split, !! lastcall 509 . float(day_ini), !! pday <-- day_ini (dans temps.h) 510 . jH_cur_split, !! ptime "fraction of day" 511 . zdt_split, !! ptimestep 512 . zplev, !! pplev 513 . zplay, !! pplay 514 . zphi, !! pphi 515 . zufi, !! pu 516 . zvfi, !! pv 517 . ztfi, !! pt 518 . zqfi, !! pq 519 . flxwfi, !! pw !! or 0. anyway this is for diagnostic. not used in physiq. 520 . zdufi, !! pdu 521 . zdvfi, !! pdv 522 . zdtfi, !! pdt 523 . zdqfi, !! pdq 524 . zdpsrf, !! pdpsrf 525 . tracerdyn) !! tracerdyn <-- utilite ??? 526 527 endif ! of if (planet_type=="earth") 528 497 529 zufi(:,:)=zufi(:,:)+zdufi(:,:)*zdt_split 498 530 zvfi(:,:)=zvfi(:,:)+zdvfi(:,:)*zdt_split … … 509 541 #endif 510 542 ! of #ifdef CPP_PHYS 511 endif ! of if (planet_type=="earth")512 543 513 544 zdufi(:,:)=zdufic(:,:)/nsplit_phys -
LMDZ5/branches/testing/libf/dyn3d/comvert.h
r1665 r1669 7 7 COMMON/comvertr/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm), & 8 8 & pa,preff,nivsigs(llm),nivsig(llm+1), & 9 & aps(llm),bps(llm),scaleheight 9 & aps(llm),bps(llm),scaleheight,pseudoalt(llm) 10 10 11 11 common/comverti/disvert_type, pressure_exner … … 23 23 real bps ! hybrid sigma contribution at mid-layers 24 24 real scaleheight ! atmospheric (reference) scale height (km) 25 real pseudoalt ! for planets 25 26 26 27 integer disvert_type ! type of vertical discretization: -
LMDZ5/branches/testing/libf/dyn3d/disvert.F90
r1665 r1669 7 7 use new_unit_m, only: new_unit 8 8 use ioipsl, only: getin 9 use assert_m, only: assert 9 10 10 11 IMPLICIT NONE … … 21 22 22 23 real,intent(in) :: pa, preff 23 real,intent(out) :: ap(llmp1), bp(llmp1) 24 real,intent(out) :: ap(llmp1) ! in Pa 25 real, intent(out):: bp(llmp1) 24 26 real,intent(out) :: dpres(llm), nivsigs(llm), nivsig(llmp1) 25 27 real,intent(out) :: presnivs(llm) … … 79 81 80 82 sig(llm+1)=0. 83 84 bp(: llm) = EXP(1. - 1. / sig(: llm)**2) 85 bp(llmp1) = 0. 86 87 ap = pa * (sig - bp) 81 88 case("tropo") 82 89 DO l = 1, llm … … 89 96 sig(l) = sig(l+1) + dsig(l) 90 97 ENDDO 98 99 bp(1)=1. 100 bp(2: llm) = EXP(1. - 1. / sig(2: llm)**2) 101 bp(llmp1) = 0. 102 103 ap(1)=0. 104 ap(2: llm + 1) = pa * (sig(2: llm + 1) - bp(2: llm + 1)) 91 105 case("strato") 92 106 if (llm==39) then … … 110 124 sig(l) = sig(l+1) + dsig(l) 111 125 ENDDO 126 127 bp(1)=1. 128 bp(2: llm) = EXP(1. - 1. / sig(2: llm)**2) 129 bp(llmp1) = 0. 130 131 ap(1)=0. 132 ap(2: llm + 1) = pa * (sig(2: llm + 1) - bp(2: llm + 1)) 112 133 case("read") 134 ! Read "ap" and "bp". First line is skipped (title line). "ap" 135 ! should be in Pa. First couple of values should correspond to 136 ! the surface, that is : "bp" should be in descending order. 113 137 call new_unit(unit) 114 138 open(unit, file="hybrid.txt", status="old", action="read", & … … 116 140 read(unit, fmt=*) ! skip title line 117 141 do l = 1, llm + 1 118 read(unit, fmt=*) sig(l)142 read(unit, fmt=*) ap(l), bp(l) 119 143 end do 120 144 close(unit) 145 call assert(ap(1) == 0., ap(llm + 1) == 0., bp(1) == 1., & 146 bp(llm + 1) == 0., "disvert: bad ap or bp values") 121 147 case default 122 148 call abort_gcm("disvert", 'Wrong value for "vert_sampling"', 1) … … 130 156 nivsig(l)= REAL(l) 131 157 ENDDO 132 133 ! .... Calculs de ap(l) et de bp(l) ....134 ! ..... pa et preff sont lus sur les fichiers start par lectba .....135 136 bp(llmp1) = 0.137 138 DO l = 1, llm139 bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )140 ap(l) = pa * ( sig(l) - bp(l) )141 ENDDO142 143 bp(1)=1.144 ap(1)=0.145 146 ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )147 158 148 159 write(lunout, *) trim(modname),': BP ' -
LMDZ5/branches/testing/libf/dyn3d/disvert_noterre.F
r1520 r1669 46 46 real tt,rr,gg, prevz 47 47 real s(llm),dsig(llm) 48 real pseudoalt(llm)49 48 50 49 integer iz -
LMDZ5/branches/testing/libf/dyn3d/dynetat0.F
r1665 r1669 6 6 7 7 USE infotrac 8 use netcdf, only: nf90_get_var 9 10 use control_mod, only : planet_type 11 8 12 IMPLICIT NONE 9 13 … … 28 32 #include "comconst.h" 29 33 #include "comvert.h" 30 #include "comgeom .h"34 #include "comgeom2.h" 31 35 #include "ener.h" 32 36 #include "netcdf.inc" … … 40 44 41 45 CHARACTER*(*) fichnom 42 REAL vcov(i p1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)43 REAL q(i p1jmp1,llm,nqtot),masse(ip1jmp1,llm)44 REAL ps(i p1jmp1),phis(ip1jmp1)46 REAL vcov(iip1, jjm,llm),ucov(iip1, jjp1,llm),teta(iip1, jjp1,llm) 47 REAL q(iip1,jjp1,llm,nqtot),masse(iip1, jjp1,llm) 48 REAL ps(iip1, jjp1),phis(iip1, jjp1) 45 49 46 50 REAL time … … 52 56 REAL tab_cntrl(length) ! tableau des parametres du run 53 57 INTEGER ierr, nid, nvarid 58 59 INTEGER idecal 54 60 55 61 c----------------------------------------------------------------------- … … 70 76 CALL abort 71 77 ENDIF 72 #ifdef NC_DOUBLE 73 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl) 74 #else 75 ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl) 76 #endif 78 ierr = nf90_get_var(nid, nvarid, tab_cntrl) 77 79 IF (ierr .NE. NF_NOERR) THEN 78 80 write(lunout,*)"dynetat0: Lecture echoue pour <controle>" 79 81 CALL abort 80 82 ENDIF 83 84 !!! AS: idecal is a hack to be able to read planeto starts... 85 !!! .... while keeping everything OK for LMDZ EARTH 86 if (planet_type.eq."generic") then 87 print*,'NOTE NOTE NOTE : Planeto-like start files' 88 idecal = 4 89 annee_ref = 2000 90 else 91 print*,'NOTE NOTE NOTE : Earth-like start files' 92 idecal = 5 93 annee_ref = tab_cntrl(5) 94 endif 95 81 96 82 97 im = tab_cntrl(1) … … 84 99 lllm = tab_cntrl(3) 85 100 day_ref = tab_cntrl(4) 86 annee_ref = tab_cntrl(5) 87 rad = tab_cntrl(6) 88 omeg = tab_cntrl(7) 89 g = tab_cntrl(8) 90 cpp = tab_cntrl(9) 91 kappa = tab_cntrl(10) 92 daysec = tab_cntrl(11) 93 dtvr = tab_cntrl(12) 94 etot0 = tab_cntrl(13) 95 ptot0 = tab_cntrl(14) 96 ztot0 = tab_cntrl(15) 97 stot0 = tab_cntrl(16) 98 ang0 = tab_cntrl(17) 99 pa = tab_cntrl(18) 100 preff = tab_cntrl(19) 101 c 102 clon = tab_cntrl(20) 103 clat = tab_cntrl(21) 104 grossismx = tab_cntrl(22) 105 grossismy = tab_cntrl(23) 106 c 107 IF ( tab_cntrl(24).EQ.1. ) THEN 101 rad = tab_cntrl(idecal+1) 102 omeg = tab_cntrl(idecal+2) 103 g = tab_cntrl(idecal+3) 104 cpp = tab_cntrl(idecal+4) 105 kappa = tab_cntrl(idecal+5) 106 daysec = tab_cntrl(idecal+6) 107 dtvr = tab_cntrl(idecal+7) 108 etot0 = tab_cntrl(idecal+8) 109 ptot0 = tab_cntrl(idecal+9) 110 ztot0 = tab_cntrl(idecal+10) 111 stot0 = tab_cntrl(idecal+11) 112 ang0 = tab_cntrl(idecal+12) 113 pa = tab_cntrl(idecal+13) 114 preff = tab_cntrl(idecal+14) 115 c 116 clon = tab_cntrl(idecal+15) 117 clat = tab_cntrl(idecal+16) 118 grossismx = tab_cntrl(idecal+17) 119 grossismy = tab_cntrl(idecal+18) 120 c 121 IF ( tab_cntrl(idecal+19).EQ.1. ) THEN 108 122 fxyhypb = . TRUE . 109 123 c dzoomx = tab_cntrl(25) … … 114 128 fxyhypb = . FALSE . 115 129 ysinus = . FALSE . 116 IF( tab_cntrl( 27).EQ.1. ) ysinus = . TRUE.130 IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE. 117 131 ENDIF 118 132 … … 142 156 CALL abort 143 157 ENDIF 144 #ifdef NC_DOUBLE 145 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu) 146 #else 147 ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu) 148 #endif 158 ierr = nf90_get_var(nid, nvarid, rlonu) 149 159 IF (ierr .NE. NF_NOERR) THEN 150 160 write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>" … … 157 167 CALL abort 158 168 ENDIF 159 #ifdef NC_DOUBLE 160 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu) 161 #else 162 ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu) 163 #endif 169 ierr = nf90_get_var(nid, nvarid, rlatu) 164 170 IF (ierr .NE. NF_NOERR) THEN 165 171 write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>" … … 172 178 CALL abort 173 179 ENDIF 174 #ifdef NC_DOUBLE 175 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv) 176 #else 177 ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv) 178 #endif 180 ierr = nf90_get_var(nid, nvarid, rlonv) 179 181 IF (ierr .NE. NF_NOERR) THEN 180 182 write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>" … … 187 189 CALL abort 188 190 ENDIF 189 #ifdef NC_DOUBLE 190 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv) 191 #else 192 ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv) 193 #endif 191 ierr = nf90_get_var(nid, nvarid, rlatv) 194 192 IF (ierr .NE. NF_NOERR) THEN 195 193 write(lunout,*)"dynetat0: Lecture echouee pour rlatv" … … 202 200 CALL abort 203 201 ENDIF 204 #ifdef NC_DOUBLE 205 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu) 206 #else 207 ierr = NF_GET_VAR_REAL(nid, nvarid, cu) 208 #endif 202 ierr = nf90_get_var(nid, nvarid, cu) 209 203 IF (ierr .NE. NF_NOERR) THEN 210 204 write(lunout,*)"dynetat0: Lecture echouee pour <cu>" … … 217 211 CALL abort 218 212 ENDIF 219 #ifdef NC_DOUBLE 220 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv) 221 #else 222 ierr = NF_GET_VAR_REAL(nid, nvarid, cv) 223 #endif 213 ierr = nf90_get_var(nid, nvarid, cv) 224 214 IF (ierr .NE. NF_NOERR) THEN 225 215 write(lunout,*)"dynetat0: Lecture echouee pour <cv>" … … 232 222 CALL abort 233 223 ENDIF 234 #ifdef NC_DOUBLE 235 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire) 236 #else 237 ierr = NF_GET_VAR_REAL(nid, nvarid, aire) 238 #endif 224 ierr = nf90_get_var(nid, nvarid, aire) 239 225 IF (ierr .NE. NF_NOERR) THEN 240 226 write(lunout,*)"dynetat0: Lecture echouee pour <aire>" … … 247 233 CALL abort 248 234 ENDIF 249 #ifdef NC_DOUBLE 250 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis) 251 #else 252 ierr = NF_GET_VAR_REAL(nid, nvarid, phis) 253 #endif 235 ierr = nf90_get_var(nid, nvarid, phis) 254 236 IF (ierr .NE. NF_NOERR) THEN 255 237 write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>" … … 260 242 IF (ierr .NE. NF_NOERR) THEN 261 243 write(lunout,*)"dynetat0: Le champ <temps> est absent" 262 CALL abort 263 ENDIF 264 #ifdef NC_DOUBLE 265 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time) 266 #else 267 ierr = NF_GET_VAR_REAL(nid, nvarid, time) 268 #endif 244 write(lunout,*)"dynetat0: J essaie <Time>" 245 ierr = NF_INQ_VARID (nid, "Time", nvarid) 246 IF (ierr .NE. NF_NOERR) THEN 247 write(lunout,*)"dynetat0: Le champ <Time> est absent" 248 CALL abort 249 ENDIF 250 ENDIF 251 ierr = nf90_get_var(nid, nvarid, time) 269 252 IF (ierr .NE. NF_NOERR) THEN 270 253 write(lunout,*)"dynetat0: Lecture echouee <temps>" … … 277 260 CALL abort 278 261 ENDIF 279 #ifdef NC_DOUBLE 280 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov) 281 #else 282 ierr = NF_GET_VAR_REAL(nid, nvarid, ucov) 283 #endif 262 ierr = nf90_get_var(nid, nvarid, ucov) 284 263 IF (ierr .NE. NF_NOERR) THEN 285 264 write(lunout,*)"dynetat0: Lecture echouee pour <ucov>" … … 292 271 CALL abort 293 272 ENDIF 294 #ifdef NC_DOUBLE 295 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov) 296 #else 297 ierr = NF_GET_VAR_REAL(nid, nvarid, vcov) 298 #endif 273 ierr = nf90_get_var(nid, nvarid, vcov) 299 274 IF (ierr .NE. NF_NOERR) THEN 300 275 write(lunout,*)"dynetat0: Lecture echouee pour <vcov>" … … 307 282 CALL abort 308 283 ENDIF 309 #ifdef NC_DOUBLE 310 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta) 311 #else 312 ierr = NF_GET_VAR_REAL(nid, nvarid, teta) 313 #endif 284 ierr = nf90_get_var(nid, nvarid, teta) 314 285 IF (ierr .NE. NF_NOERR) THEN 315 286 write(lunout,*)"dynetat0: Lecture echouee pour <teta>" … … 325 296 & "> est absent" 326 297 write(lunout,*)" Il est donc initialise a zero" 327 q(:,:, iq)=0.298 q(:,:,:,iq)=0. 328 299 ELSE 329 #ifdef NC_DOUBLE 330 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,iq)) 331 #else 332 ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,iq)) 333 #endif 300 ierr = NF90_GET_VAR(nid, nvarid, q(:,:,:,iq)) 334 301 IF (ierr .NE. NF_NOERR) THEN 335 302 write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq) … … 345 312 CALL abort 346 313 ENDIF 347 #ifdef NC_DOUBLE 348 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse) 349 #else 350 ierr = NF_GET_VAR_REAL(nid, nvarid, masse) 351 #endif 314 ierr = nf90_get_var(nid, nvarid, masse) 352 315 IF (ierr .NE. NF_NOERR) THEN 353 316 write(lunout,*)"dynetat0: Lecture echouee pour <masse>" … … 360 323 CALL abort 361 324 ENDIF 362 #ifdef NC_DOUBLE 363 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps) 364 #else 365 ierr = NF_GET_VAR_REAL(nid, nvarid, ps) 366 #endif 325 ierr = nf90_get_var(nid, nvarid, ps) 367 326 IF (ierr .NE. NF_NOERR) THEN 368 327 write(lunout,*)"dynetat0: Lecture echouee pour <ps>" -
LMDZ5/branches/testing/libf/dyn3d/dynredem.F
r1665 r1669 8 8 #endif 9 9 USE infotrac 10 use netcdf95, only: NF95_PUT_VAR 10 11 11 12 IMPLICIT NONE … … 19 20 #include "comconst.h" 20 21 #include "comvert.h" 21 #include "comgeom .h"22 #include "comgeom2.h" 22 23 #include "temps.h" 23 24 #include "ener.h" … … 31 32 c ---------- 32 33 INTEGER iday_end 33 REAL phis(i p1jmp1)34 REAL phis(iip1, jjp1) 34 35 CHARACTER*(*) fichnom 35 36 … … 166 167 . "Parametres de controle") 167 168 ierr = NF_ENDDEF(nid) 168 #ifdef NC_DOUBLE 169 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) 170 #else 171 ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl) 172 #endif 169 call NF95_PUT_VAR(nid,nvarid,tab_cntrl) 173 170 c 174 171 ierr = NF_REDEF (nid) … … 183 180 . "Longitudes des points U") 184 181 ierr = NF_ENDDEF(nid) 185 #ifdef NC_DOUBLE 186 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu) 187 #else 188 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu) 189 #endif 182 call NF95_PUT_VAR(nid,nvarid,rlonu) 190 183 c 191 184 ierr = NF_REDEF (nid) … … 200 193 . "Latitudes des points U") 201 194 ierr = NF_ENDDEF(nid) 202 #ifdef NC_DOUBLE 203 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu) 204 #else 205 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu) 206 #endif 195 call NF95_PUT_VAR (nid,nvarid,rlatu) 207 196 c 208 197 ierr = NF_REDEF (nid) … … 217 206 . "Longitudes des points V") 218 207 ierr = NF_ENDDEF(nid) 219 #ifdef NC_DOUBLE 220 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv) 221 #else 222 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv) 223 #endif 208 call NF95_PUT_VAR(nid,nvarid,rlonv) 224 209 c 225 210 ierr = NF_REDEF (nid) … … 234 219 . "Latitudes des points V") 235 220 ierr = NF_ENDDEF(nid) 236 #ifdef NC_DOUBLE 237 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv) 238 #else 239 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv) 240 #endif 221 call NF95_PUT_VAR(nid,nvarid,rlatv) 241 222 c 242 223 ierr = NF_REDEF (nid) … … 251 232 . "Numero naturel des couches s") 252 233 ierr = NF_ENDDEF(nid) 253 #ifdef NC_DOUBLE 254 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs) 255 #else 256 ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs) 257 #endif 234 call NF95_PUT_VAR(nid,nvarid,nivsigs) 258 235 c 259 236 ierr = NF_REDEF (nid) … … 268 245 . "Numero naturel des couches sigma") 269 246 ierr = NF_ENDDEF(nid) 270 #ifdef NC_DOUBLE 271 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig) 272 #else 273 ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig) 274 #endif 247 call NF95_PUT_VAR(nid,nvarid,nivsig) 275 248 c 276 249 ierr = NF_REDEF (nid) … … 285 258 . "Coefficient A pour hybride") 286 259 ierr = NF_ENDDEF(nid) 287 #ifdef NC_DOUBLE 288 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap) 289 #else 290 ierr = NF_PUT_VAR_REAL (nid,nvarid,ap) 291 #endif 260 call NF95_PUT_VAR(nid,nvarid,ap) 292 261 c 293 262 ierr = NF_REDEF (nid) … … 302 271 . "Coefficient B pour hybride") 303 272 ierr = NF_ENDDEF(nid) 304 #ifdef NC_DOUBLE 305 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp) 306 #else 307 ierr = NF_PUT_VAR_REAL (nid,nvarid,bp) 308 #endif 273 call NF95_PUT_VAR(nid,nvarid,bp) 309 274 c 310 275 ierr = NF_REDEF (nid) … … 317 282 cIM 220306 END 318 283 ierr = NF_ENDDEF(nid) 319 #ifdef NC_DOUBLE 320 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs) 321 #else 322 ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs) 323 #endif 284 call NF95_PUT_VAR(nid,nvarid,presnivs) 324 285 c 325 286 c Coefficients de passage cov. <-> contra. <--> naturel … … 338 299 . "Coefficient de passage pour U") 339 300 ierr = NF_ENDDEF(nid) 340 #ifdef NC_DOUBLE 341 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu) 342 #else 343 ierr = NF_PUT_VAR_REAL (nid,nvarid,cu) 344 #endif 301 call NF95_PUT_VAR(nid,nvarid,cu) 345 302 c 346 303 ierr = NF_REDEF (nid) … … 357 314 . "Coefficient de passage pour V") 358 315 ierr = NF_ENDDEF(nid) 359 #ifdef NC_DOUBLE 360 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv) 361 #else 362 ierr = NF_PUT_VAR_REAL (nid,nvarid,cv) 363 #endif 316 call NF95_PUT_VAR(nid,nvarid,cv) 364 317 c 365 318 c Aire de chaque maille: … … 378 331 . "Aires de chaque maille") 379 332 ierr = NF_ENDDEF(nid) 380 #ifdef NC_DOUBLE 381 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire) 382 #else 383 ierr = NF_PUT_VAR_REAL (nid,nvarid,aire) 384 #endif 333 call NF95_PUT_VAR(nid,nvarid,aire) 385 334 c 386 335 c Geopentiel au sol: … … 399 348 . "Geopotentiel au sol") 400 349 ierr = NF_ENDDEF(nid) 401 #ifdef NC_DOUBLE 402 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis) 403 #else 404 ierr = NF_PUT_VAR_REAL (nid,nvarid,phis) 405 #endif 350 call NF95_PUT_VAR(nid,nvarid,phis) 406 351 c 407 352 c Definir les variables pour pouvoir les enregistrer plus tard: … … 524 469 USE infotrac 525 470 USE control_mod 471 use netcdf, only: NF90_get_VAR 472 use netcdf95, only: NF95_PUT_VAR 526 473 527 474 IMPLICIT NONE … … 540 487 541 488 INTEGER l 542 REAL vcov(i p1jm,llm),ucov(ip1jmp1,llm)543 REAL teta(i p1jmp1,llm)544 REAL ps(i p1jmp1),masse(ip1jmp1,llm)545 REAL q(i p1jmp1,llm,nqtot)489 REAL vcov(iip1,jjm,llm),ucov(iip1, jjp1,llm) 490 REAL teta(iip1, jjp1,llm) 491 REAL ps(iip1, jjp1),masse(iip1, jjp1,llm) 492 REAL q(iip1, jjp1, llm, nqtot) 546 493 CHARACTER*(*) fichnom 547 494 … … 577 524 CALL abort_gcm(modname,abort_message,ierr) 578 525 ENDIF 579 #ifdef NC_DOUBLE 580 ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time) 581 #else 582 ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time) 583 #endif 526 call NF95_PUT_VAR(nid,nvarid,time,start=(/nb/)) 584 527 write(lunout,*) "dynredem1: Enregistrement pour ", nb, time 585 528 … … 593 536 CALL abort_gcm(modname,abort_message,ierr) 594 537 ENDIF 595 #ifdef NC_DOUBLE 596 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl) 597 #else 598 ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl) 599 #endif 538 ierr = NF90_GET_VAR(nid, nvarid, tab_cntrl) 600 539 tab_cntrl(31) = REAL(itau_dyn + itaufin) 601 #ifdef NC_DOUBLE 602 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) 603 #else 604 ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl) 605 #endif 540 call NF95_PUT_VAR(nid,nvarid,tab_cntrl) 606 541 607 542 c Ecriture des champs … … 613 548 CALL abort_gcm(modname,abort_message,ierr) 614 549 ENDIF 615 #ifdef NC_DOUBLE 616 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov) 617 #else 618 ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov) 619 #endif 550 call NF95_PUT_VAR(nid,nvarid,ucov) 620 551 621 552 ierr = NF_INQ_VARID(nid, "vcov", nvarid) … … 625 556 CALL abort_gcm(modname,abort_message,ierr) 626 557 ENDIF 627 #ifdef NC_DOUBLE 628 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov) 629 #else 630 ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov) 631 #endif 558 call NF95_PUT_VAR(nid,nvarid,vcov) 632 559 633 560 ierr = NF_INQ_VARID(nid, "teta", nvarid) … … 637 564 CALL abort_gcm(modname,abort_message,ierr) 638 565 ENDIF 639 #ifdef NC_DOUBLE 640 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta) 641 #else 642 ierr = NF_PUT_VAR_REAL (nid,nvarid,teta) 643 #endif 566 call NF95_PUT_VAR(nid,nvarid,teta) 644 567 645 568 IF (type_trac == 'inca') THEN … … 663 586 CALL abort_gcm(modname,abort_message,ierr) 664 587 ENDIF 665 #ifdef NC_DOUBLE 666 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) 667 #else 668 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 669 #endif 588 call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq)) 670 589 ELSE ! type_trac = inca 671 590 ! lecture de la valeur du traceur dans start_trac.nc … … 682 601 CALL abort_gcm(modname,abort_message,ierr) 683 602 ENDIF 684 #ifdef NC_DOUBLE 685 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) 686 #else 687 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 688 #endif 603 call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq)) 689 604 690 605 ELSE 691 606 write(lunout,*) "dynredem1: ",trim(tname(iq)), 692 607 & " est present dans start_trac.nc" 693 #ifdef NC_DOUBLE 694 ierr = NF_GET_VAR_DOUBLE(nid_trac, nvarid_trac, trac_tmp) 695 #else 696 ierr = NF_GET_VAR_REAL(nid_trac, nvarid_trac, trac_tmp) 697 #endif 608 ierr = NF90_GET_VAR(nid_trac, nvarid_trac, trac_tmp) 698 609 IF (ierr .NE. NF_NOERR) THEN 699 610 abort_message="dynredem1: Lecture echouee pour"// … … 709 620 CALL abort_gcm(modname,abort_message,ierr) 710 621 ENDIF 711 #ifdef NC_DOUBLE 712 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,trac_tmp) 713 #else 714 ierr = NF_PUT_VAR_REAL (nid,nvarid,trac_tmp) 715 #endif 622 call NF95_PUT_VAR(nid, nvarid, trac_tmp) 716 623 717 624 ENDIF ! IF (ierr .NE. NF_NOERR) … … 726 633 CALL abort_gcm(modname,abort_message,ierr) 727 634 ENDIF 728 #ifdef NC_DOUBLE 729 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) 730 #else 731 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 732 #endif 635 call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq)) 733 636 ENDIF ! (ierr_file .ne. 2) 734 637 END IF !type_trac … … 743 646 CALL abort_gcm(modname,abort_message,ierr) 744 647 ENDIF 745 #ifdef NC_DOUBLE 746 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse) 747 #else 748 ierr = NF_PUT_VAR_REAL (nid,nvarid,masse) 749 #endif 648 call NF95_PUT_VAR(nid,nvarid,masse) 750 649 c 751 650 ierr = NF_INQ_VARID(nid, "ps", nvarid) … … 755 654 CALL abort_gcm(modname,abort_message,ierr) 756 655 ENDIF 757 #ifdef NC_DOUBLE 758 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps) 759 #else 760 ierr = NF_PUT_VAR_REAL (nid,nvarid,ps) 761 #endif 656 call NF95_PUT_VAR(nid,nvarid,ps) 762 657 763 658 ierr = NF_CLOSE(nid) -
LMDZ5/branches/testing/libf/dyn3d/leapfrog.F
r1665 r1669 413 413 c-jld 414 414 #ifdef CPP_IOIPSL 415 cIM : pour sortir les param. du modele dans un fis. netcdf 110106 416 IF (first) THEN 417 first=.false. 418 #include "ini_paramLMDZ_dyn.h" 419 ENDIF 420 c 421 #include "write_paramLMDZ_dyn.h" 415 cIM decommenter les 6 lignes suivantes pour sortir quelques parametres dynamiques de LMDZ 416 cIM uncomment next 6 lines to get some parameters for LMDZ dynamics 417 c IF (first) THEN 418 c first=.false. 419 c#include "ini_paramLMDZ_dyn.h" 420 c ENDIF 421 c 422 c#include "write_paramLMDZ_dyn.h" 422 423 c 423 424 #endif
Note: See TracChangeset
for help on using the changeset viewer.