Changeset 776 for trunk/LMDZ.COMMON/libf/dyn3dpar
- Timestamp:
- Sep 7, 2012, 2:49:58 PM (12 years ago)
- Location:
- trunk/LMDZ.COMMON/libf/dyn3dpar
- Files:
-
- 24 edited
- 1 moved
-
bands.F90 (modified) (5 diffs)
-
calfis_p.F (modified) (6 diffs)
-
ce0l.F90 (modified) (2 diffs)
-
comvert.h (modified) (3 diffs)
-
disvert.F90 (modified) (6 diffs)
-
dynetat0.F (modified) (19 diffs)
-
dynredem.F (modified) (32 diffs)
-
dynredem_p.F (modified) (37 diffs)
-
etat0_netcdf.F90 (modified) (2 diffs)
-
exner_hyb.F (modified) (1 diff)
-
exner_hyb_p.F (modified) (1 diff)
-
exner_milieu.F (modified) (1 diff)
-
exner_milieu_p.F (modified) (1 diff)
-
gcm.F (modified) (7 diffs)
-
gr_dyn_fi_p.F (modified) (2 diffs)
-
gr_fi_dyn_p.F (modified) (2 diffs)
-
guide_p_mod.F90 (modified) (2 diffs)
-
iniacademic.F90 (modified) (2 diffs)
-
iniconst.F90 (moved) (moved from trunk/LMDZ.COMMON/libf/dyn3dpar/iniconst.F) (1 diff)
-
inidissip.F90 (modified) (3 diffs)
-
inigrads.F (modified) (3 diffs)
-
integrd_p.F (modified) (7 diffs)
-
leapfrog_p.F (modified) (17 diffs)
-
mod_interface_dyn_phys.F90 (modified) (3 diffs)
-
wrgrads.F (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.COMMON/libf/dyn3dpar/bands.F90
r1 r776 1 1 ! 2 ! $Id: bands.F90 1 279 2009-12-10 09:02:56Z fairhead$2 ! $Id: bands.F90 1615 2012-02-10 15:42:26Z emillour $ 3 3 ! 4 4 module Bands … … 93 93 SUBROUTINE Set_Bands 94 94 USE parallel 95 #ifdef CPP_ EARTH96 ! Ehouarn: what follows is only related to // physics ; for now only for Earth95 #ifdef CPP_PHYS 96 ! Ehouarn: what follows is only related to // physics 97 97 USE mod_phys_lmdz_para, ONLY : jj_para_begin,jj_para_end 98 98 #endif … … 106 106 enddo 107 107 108 #ifdef CPP_EARTH 109 ! Ehouarn: what follows is only related to // physics; for now only for Earth 108 #ifdef CPP_PHYS 110 109 do i=0,MPI_Size-1 111 110 jj_Nb_physic(i)=jj_para_end(i)-jj_para_begin(i)+1 … … 332 331 subroutine AdjustBands_physic 333 332 use times 334 #ifdef CPP_ EARTH335 ! Ehouarn: what follows is only related to // physics ; for now only for Earth333 #ifdef CPP_PHYS 334 ! Ehouarn: what follows is only related to // physics 336 335 USE mod_phys_lmdz_para, only : klon_mpi_para_nb 337 336 #endif … … 359 358 medium=medium/mpi_size 360 359 NbTot=0 361 #ifdef CPP_EARTH 362 ! Ehouarn: what follows is only related to // physics; for now only for Earth 360 #ifdef CPP_PHYS 363 361 do i=0,mpi_size-1 364 362 Inc(i)=nint(klon_mpi_para_nb(i)*(medium-value(i))/value(i)) -
trunk/LMDZ.COMMON/libf/dyn3dpar/calfis_p.F
r108 r776 27 27 $ pdpsfi) 28 28 #ifdef CPP_PHYS 29 ! Ehouarn: For now, calfis_p needs Earth physics 30 c 31 c Auteur : P. Le Van, F. Hourdin 32 c ......... 29 ! Ehouarn: if using (parallelized) physics 33 30 USE dimphy 34 31 USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root … … 225 222 PARAMETER(ntetaSTD=3) 226 223 REAL rtetaSTD(ntetaSTD) 227 DATA rtetaSTD/350., 380., 405./ 224 DATA rtetaSTD/350., 380., 405./ ! Earth-specific values, beware !! 228 225 REAL PVteta(klon,ntetaSTD) 229 226 … … 512 509 513 510 514 IF (is_sequential) THEN 515 c 511 IF (is_sequential.and.(planet_type=="earth")) THEN 512 #ifdef CPP_PHYS 513 ! PVtheta calls tetalevel, which is in the physics 516 514 cIM calcul PV a teta=350, 380, 405K 517 515 CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta, … … 519 517 $ ntetaSTD,rtetaSTD,PVteta) 520 518 c 519 #endif 521 520 ENDIF 522 521 … … 666 665 zdqfic_omp(:,:,:)=0. 667 666 667 #ifdef CPP_PHYS 668 668 do isplit=1,nsplit_phys 669 669 … … 742 742 enddo 743 743 744 #endif 745 ! of #ifdef CPP_PHYS 746 744 747 zdufi_omp(:,:)=zdufic_omp(:,:)/nsplit_phys 745 748 zdvfi_omp(:,:)=zdvfic_omp(:,:)/nsplit_phys -
trunk/LMDZ.COMMON/libf/dyn3dpar/ce0l.F90
r492 r776 1 1 ! 2 ! $Id: ce0l.F90 16 00 2011-12-06 13:16:30Z jghattas$2 ! $Id: ce0l.F90 1615 2012-02-10 15:42:26Z emillour $ 3 3 ! 4 4 !------------------------------------------------------------------------------- … … 31 31 IMPLICIT NONE 32 32 #ifndef CPP_EARTH 33 WRITE(*,*)'limit_netcdf: Earth-specific routine, needs Earth physics' 33 #include "iniprint.h" 34 WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics' 34 35 #else 35 36 !------------------------------------------------------------------------------- -
trunk/LMDZ.COMMON/libf/dyn3dpar/comvert.h
r127 r776 1 1 ! 2 ! $Id: comvert.h 1 520 2011-05-23 11:37:09Z emillour$2 ! $Id: comvert.h 1625 2012-05-09 13:14:48Z lguez $ 3 3 ! 4 4 !----------------------------------------------------------------------- … … 9 9 & aps(llm),bps(llm),scaleheight 10 10 11 common/comverti/disvert_type 11 common/comverti/disvert_type, pressure_exner 12 12 13 13 real ap ! hybrid pressure contribution at interlayers … … 30 30 ! using 'z2sig.def' (or 'esasig.def) file 31 31 32 logical pressure_exner 33 ! compute pressure inside layers using Exner function, else use mean 34 ! of pressure values at interfaces 35 32 36 !----------------------------------------------------------------------- -
trunk/LMDZ.COMMON/libf/dyn3dpar/disvert.F90
r128 r776 1 ! $Id: disvert.F90 1 520 2011-05-23 11:37:09Z emillour$1 ! $Id: disvert.F90 1645 2012-07-30 16:01:50Z lguez $ 2 2 3 3 SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig,scaleheight) 4 4 5 5 ! Auteur : P. Le Van 6 7 use new_unit_m, only: new_unit 8 use ioipsl, only: getin 9 use assert_m, only: assert 6 10 7 11 IMPLICIT NONE … … 18 22 19 23 real,intent(in) :: pa, preff 20 real,intent(out) :: ap(llmp1), bp(llmp1) 24 real,intent(out) :: ap(llmp1) ! in Pa 25 real, intent(out):: bp(llmp1) 21 26 real,intent(out) :: dpres(llm), nivsigs(llm), nivsig(llmp1) 22 27 real,intent(out) :: presnivs(llm) … … 26 31 real zk, zkm1, dzk1, dzk2, k0, k1 27 32 28 INTEGER l 33 INTEGER l, unit 29 34 REAL dsigmin 30 35 REAL alpha, beta, deltaz 31 INTEGER iostat32 36 REAL x 33 37 character(len=*),parameter :: modname="disvert" 34 38 39 character(len=6):: vert_sampling 40 ! (allowed values are "param", "tropo", "strato" and "read") 41 35 42 !----------------------------------------------------------------------- 43 44 print *, "Call sequence information: disvert" 36 45 37 46 ! default scaleheight is 8km for earth 38 47 scaleheight=8. 39 48 40 OPEN(99, file='sigma.def', status='old', form='formatted', iostat=iostat) 49 vert_sampling = merge("strato", "tropo ", ok_strato) ! default value 50 call getin('vert_sampling', vert_sampling) 51 print *, 'vert_sampling = ' // vert_sampling 41 52 42 IF (iostat == 0) THEN 43 ! cas 1 on lit les options dans sigma.def: 53 select case (vert_sampling) 54 case ("param") 55 ! On lit les options dans sigma.def: 56 OPEN(99, file='sigma.def', status='old', form='formatted') 44 57 READ(99, *) scaleheight ! hauteur d'echelle 8. 45 58 READ(99, *) deltaz ! epaiseur de la premiere couche 0.04 … … 69 82 sig(llm+1)=0. 70 83 71 DO l = 1, llm 72 dsig(l) = sig(l)-sig(l+1) 73 end DO 74 ELSE 75 if (ok_strato) then 76 if (llm==39) then 77 dsigmin=0.3 78 else if (llm==50) then 79 dsigmin=1. 80 else 81 write(lunout,*) trim(modname), & 82 ' ATTENTION discretisation z a ajuster' 83 dsigmin=1. 84 endif 85 write(lunout,*) trim(modname), & 86 ' Discretisation verticale DSIGMIN=',dsigmin 87 endif 84 bp(: llm) = EXP(1. - 1. / sig(: llm)**2) 85 bp(llmp1) = 0. 88 86 87 ap = pa * (sig - bp) 88 case("tropo") 89 89 DO l = 1, llm 90 90 x = 2*asin(1.) * (l - 0.5) / (llm + 1) 91 92 IF (ok_strato) THEN 93 dsig(l) =(dsigmin + 7. * SIN(x)**2) & 94 *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2 95 ELSE 96 dsig(l) = 1.0 + 7.0 * SIN(x)**2 97 ENDIF 91 dsig(l) = 1.0 + 7.0 * SIN(x)**2 98 92 ENDDO 99 93 dsig = dsig / sum(dsig) … … 102 96 sig(l) = sig(l+1) + dsig(l) 103 97 ENDDO 104 ENDIF 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)) 105 case("strato") 106 if (llm==39) then 107 dsigmin=0.3 108 else if (llm==50) then 109 dsigmin=1. 110 else 111 write(lunout,*) trim(modname), ' ATTENTION discretisation z a ajuster' 112 dsigmin=1. 113 endif 114 WRITE(LUNOUT,*) trim(modname), 'Discretisation verticale DSIGMIN=',dsigmin 115 116 DO l = 1, llm 117 x = 2*asin(1.) * (l - 0.5) / (llm + 1) 118 dsig(l) =(dsigmin + 7. * SIN(x)**2) & 119 *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2 120 ENDDO 121 dsig = dsig / sum(dsig) 122 sig(llm+1) = 0. 123 DO l = llm, 1, -1 124 sig(l) = sig(l+1) + dsig(l) 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)) 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. 137 call new_unit(unit) 138 open(unit, file="hybrid.txt", status="old", action="read", & 139 position="rewind") 140 read(unit, fmt=*) ! skip title line 141 do l = 1, llm + 1 142 read(unit, fmt=*) ap(l), bp(l) 143 end do 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") 147 case default 148 call abort_gcm("disvert", 'Wrong value for "vert_sampling"', 1) 149 END select 105 150 106 151 DO l=1, llm … … 111 156 nivsig(l)= REAL(l) 112 157 ENDDO 113 114 ! .... Calculs de ap(l) et de bp(l) ....115 ! ..... pa et preff sont lus sur les fichiers start par lectba .....116 117 bp(llmp1) = 0.118 119 DO l = 1, llm120 bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )121 ap(l) = pa * ( sig(l) - bp(l) )122 ENDDO123 124 bp(1)=1.125 ap(1)=0.126 127 ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )128 158 129 159 write(lunout, *) trim(modname),': BP ' -
trunk/LMDZ.COMMON/libf/dyn3dpar/dynetat0.F
r492 r776 6 6 7 7 USE infotrac 8 use netcdf, only: nf90_get_var 8 9 IMPLICIT NONE 9 10 … … 28 29 #include "comconst.h" 29 30 #include "comvert.h" 30 #include "comgeom .h"31 #include "comgeom2.h" 31 32 #include "ener.h" 32 33 #include "netcdf.inc" … … 40 41 41 42 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)43 REAL vcov(iip1, jjm,llm),ucov(iip1, jjp1,llm),teta(iip1, jjp1,llm) 44 REAL q(iip1,jjp1,llm,nqtot),masse(iip1, jjp1,llm) 45 REAL ps(iip1, jjp1),phis(iip1, jjp1) 45 46 46 47 REAL time … … 70 71 CALL abort 71 72 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 73 ierr = nf90_get_var(nid, nvarid, tab_cntrl) 77 74 IF (ierr .NE. NF_NOERR) THEN 78 75 write(lunout,*)"dynetat0: Lecture echoue pour <controle>" … … 142 139 CALL abort 143 140 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 141 ierr = nf90_get_var(nid, nvarid, rlonu) 149 142 IF (ierr .NE. NF_NOERR) THEN 150 143 write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>" … … 157 150 CALL abort 158 151 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 152 ierr = nf90_get_var(nid, nvarid, rlatu) 164 153 IF (ierr .NE. NF_NOERR) THEN 165 154 write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>" … … 172 161 CALL abort 173 162 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 163 ierr = nf90_get_var(nid, nvarid, rlonv) 179 164 IF (ierr .NE. NF_NOERR) THEN 180 165 write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>" … … 187 172 CALL abort 188 173 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 174 ierr = nf90_get_var(nid, nvarid, rlatv) 194 175 IF (ierr .NE. NF_NOERR) THEN 195 176 write(lunout,*)"dynetat0: Lecture echouee pour rlatv" … … 202 183 CALL abort 203 184 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 185 ierr = nf90_get_var(nid, nvarid, cu) 209 186 IF (ierr .NE. NF_NOERR) THEN 210 187 write(lunout,*)"dynetat0: Lecture echouee pour <cu>" … … 217 194 CALL abort 218 195 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 196 ierr = nf90_get_var(nid, nvarid, cv) 224 197 IF (ierr .NE. NF_NOERR) THEN 225 198 write(lunout,*)"dynetat0: Lecture echouee pour <cv>" … … 232 205 CALL abort 233 206 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 207 ierr = nf90_get_var(nid, nvarid, aire) 239 208 IF (ierr .NE. NF_NOERR) THEN 240 209 write(lunout,*)"dynetat0: Lecture echouee pour <aire>" … … 247 216 CALL abort 248 217 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 218 ierr = nf90_get_var(nid, nvarid, phis) 254 219 IF (ierr .NE. NF_NOERR) THEN 255 220 write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>" … … 262 227 CALL abort 263 228 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 229 ierr = nf90_get_var(nid, nvarid, time) 269 230 IF (ierr .NE. NF_NOERR) THEN 270 231 write(lunout,*)"dynetat0: Lecture echouee <temps>" … … 277 238 CALL abort 278 239 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 240 ierr = nf90_get_var(nid, nvarid, ucov) 284 241 IF (ierr .NE. NF_NOERR) THEN 285 242 write(lunout,*)"dynetat0: Lecture echouee pour <ucov>" … … 292 249 CALL abort 293 250 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 251 ierr = nf90_get_var(nid, nvarid, vcov) 299 252 IF (ierr .NE. NF_NOERR) THEN 300 253 write(lunout,*)"dynetat0: Lecture echouee pour <vcov>" … … 307 260 CALL abort 308 261 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 262 ierr = nf90_get_var(nid, nvarid, teta) 314 263 IF (ierr .NE. NF_NOERR) THEN 315 264 write(lunout,*)"dynetat0: Lecture echouee pour <teta>" … … 325 274 & "> est absent" 326 275 write(lunout,*)" Il est donc initialise a zero" 327 q(:,:, iq)=0.276 q(:,:,:,iq)=0. 328 277 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 278 ierr = NF90_GET_VAR(nid, nvarid, q(:,:,:,iq)) 334 279 IF (ierr .NE. NF_NOERR) THEN 335 280 write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq) … … 345 290 CALL abort 346 291 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 292 ierr = nf90_get_var(nid, nvarid, masse) 352 293 IF (ierr .NE. NF_NOERR) THEN 353 294 write(lunout,*)"dynetat0: Lecture echouee pour <masse>" … … 360 301 CALL abort 361 302 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 303 ierr = nf90_get_var(nid, nvarid, ps) 367 304 IF (ierr .NE. NF_NOERR) THEN 368 305 write(lunout,*)"dynetat0: Lecture echouee pour <ps>" -
trunk/LMDZ.COMMON/libf/dyn3dpar/dynredem.F
r492 r776 1 1 ! 2 ! $Id: dynredem.F 1 403 2010-07-01 09:02:53Z fairhead$2 ! $Id: dynredem.F 1635 2012-07-12 11:37:16Z lguez $ 3 3 ! 4 4 c … … 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 … … 138 139 c 139 140 ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27, 140 . "Fichier dem arrage dynamique")141 . "Fichier demmarage dynamique") 141 142 c 142 143 c Definir les dimensions du fichiers: … … 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 … … 538 485 #include "iniprint.h" 539 486 487 540 488 INTEGER l 541 REAL vcov(i p1jm,llm),ucov(ip1jmp1,llm)542 REAL teta(i p1jmp1,llm)543 REAL ps(i p1jmp1),masse(ip1jmp1,llm)544 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) 545 493 CHARACTER*(*) fichnom 546 494 … … 576 524 CALL abort_gcm(modname,abort_message,ierr) 577 525 ENDIF 578 #ifdef NC_DOUBLE 579 ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time) 580 #else 581 ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time) 582 #endif 526 call NF95_PUT_VAR(nid,nvarid,time,start=(/nb/)) 583 527 write(lunout,*) "dynredem1: Enregistrement pour ", nb, time 584 528 … … 592 536 CALL abort_gcm(modname,abort_message,ierr) 593 537 ENDIF 594 #ifdef NC_DOUBLE 595 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl) 596 #else 597 ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl) 598 #endif 538 ierr = NF90_GET_VAR(nid, nvarid, tab_cntrl) 599 539 tab_cntrl(31) = REAL(itau_dyn + itaufin) 600 #ifdef NC_DOUBLE 601 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) 602 #else 603 ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl) 604 #endif 540 call NF95_PUT_VAR(nid,nvarid,tab_cntrl) 605 541 606 542 c Ecriture des champs … … 612 548 CALL abort_gcm(modname,abort_message,ierr) 613 549 ENDIF 614 #ifdef NC_DOUBLE 615 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov) 616 #else 617 ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov) 618 #endif 550 call NF95_PUT_VAR(nid,nvarid,ucov) 619 551 620 552 ierr = NF_INQ_VARID(nid, "vcov", nvarid) … … 624 556 CALL abort_gcm(modname,abort_message,ierr) 625 557 ENDIF 626 #ifdef NC_DOUBLE 627 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov) 628 #else 629 ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov) 630 #endif 558 call NF95_PUT_VAR(nid,nvarid,vcov) 631 559 632 560 ierr = NF_INQ_VARID(nid, "teta", nvarid) … … 636 564 CALL abort_gcm(modname,abort_message,ierr) 637 565 ENDIF 638 #ifdef NC_DOUBLE 639 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta) 640 #else 641 ierr = NF_PUT_VAR_REAL (nid,nvarid,teta) 642 #endif 566 call NF95_PUT_VAR(nid,nvarid,teta) 643 567 644 568 IF (type_trac == 'inca') THEN … … 662 586 CALL abort_gcm(modname,abort_message,ierr) 663 587 ENDIF 664 #ifdef NC_DOUBLE 665 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) 666 #else 667 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 668 #endif 588 call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq)) 669 589 ELSE ! type_trac = inca 670 590 ! lecture de la valeur du traceur dans start_trac.nc … … 681 601 CALL abort_gcm(modname,abort_message,ierr) 682 602 ENDIF 683 #ifdef NC_DOUBLE 684 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) 685 #else 686 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 687 #endif 603 call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq)) 688 604 689 605 ELSE 690 606 write(lunout,*) "dynredem1: ",trim(tname(iq)), 691 607 & " est present dans start_trac.nc" 692 #ifdef NC_DOUBLE 693 ierr = NF_GET_VAR_DOUBLE(nid_trac, nvarid_trac, trac_tmp) 694 #else 695 ierr = NF_GET_VAR_REAL(nid_trac, nvarid_trac, trac_tmp) 696 #endif 608 ierr = NF90_GET_VAR(nid_trac, nvarid_trac, trac_tmp) 697 609 IF (ierr .NE. NF_NOERR) THEN 698 610 abort_message="dynredem1: Lecture echouee pour"// … … 708 620 CALL abort_gcm(modname,abort_message,ierr) 709 621 ENDIF 710 #ifdef NC_DOUBLE 711 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,trac_tmp) 712 #else 713 ierr = NF_PUT_VAR_REAL (nid,nvarid,trac_tmp) 714 #endif 622 call NF95_PUT_VAR(nid, nvarid, trac_tmp) 715 623 716 624 ENDIF ! IF (ierr .NE. NF_NOERR) … … 725 633 CALL abort_gcm(modname,abort_message,ierr) 726 634 ENDIF 727 #ifdef NC_DOUBLE 728 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) 729 #else 730 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 731 #endif 635 call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq)) 732 636 ENDIF ! (ierr_file .ne. 2) 733 637 END IF !type_trac … … 742 646 CALL abort_gcm(modname,abort_message,ierr) 743 647 ENDIF 744 #ifdef NC_DOUBLE 745 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse) 746 #else 747 ierr = NF_PUT_VAR_REAL (nid,nvarid,masse) 748 #endif 648 call NF95_PUT_VAR(nid,nvarid,masse) 749 649 c 750 650 ierr = NF_INQ_VARID(nid, "ps", nvarid) … … 754 654 CALL abort_gcm(modname,abort_message,ierr) 755 655 ENDIF 756 #ifdef NC_DOUBLE 757 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps) 758 #else 759 ierr = NF_PUT_VAR_REAL (nid,nvarid,ps) 760 #endif 656 call NF95_PUT_VAR(nid,nvarid,ps) 761 657 762 658 ierr = NF_CLOSE(nid) -
trunk/LMDZ.COMMON/libf/dyn3dpar/dynredem_p.F
r492 r776 1 1 ! 2 ! $Id: dynredem_p.F 1 577 2011-10-20 15:06:47Z fairhead$2 ! $Id: dynredem_p.F 1635 2012-07-12 11:37:16Z lguez $ 3 3 ! 4 4 c … … 9 9 USE parallel 10 10 USE infotrac 11 use netcdf95, only: NF95_PUT_VAR 12 11 13 IMPLICIT NONE 12 14 c======================================================================= … … 19 21 #include "comconst.h" 20 22 #include "comvert.h" 21 #include "comgeom .h"23 #include "comgeom2.h" 22 24 #include "temps.h" 23 25 #include "ener.h" … … 30 32 c ---------- 31 33 INTEGER iday_end 32 REAL phis(i p1jmp1)34 REAL phis(iip1, jjp1) 33 35 CHARACTER*(*) fichnom 34 36 … … 56 58 character*30 unites 57 59 60 58 61 c----------------------------------------------------------------------- 59 62 if (mpi_rank==0) then … … 69 72 mmois0=1 70 73 jjour0=1 71 #endif 74 #endif 72 75 73 76 DO l=1,length 74 77 tab_cntrl(l) = 0. 75 78 ENDDO 76 tab_cntrl(1) = 77 tab_cntrl(2) = 78 tab_cntrl(3) = 79 tab_cntrl(4) = 80 tab_cntrl(5) = 79 tab_cntrl(1) = REAL(iim) 80 tab_cntrl(2) = REAL(jjm) 81 tab_cntrl(3) = REAL(llm) 82 tab_cntrl(4) = REAL(day_ref) 83 tab_cntrl(5) = REAL(annee_ref) 81 84 tab_cntrl(6) = rad 82 85 tab_cntrl(7) = omeg … … 118 121 ENDIF 119 122 120 tab_cntrl(30) = 121 tab_cntrl(31) = 123 tab_cntrl(30) = REAL(iday_end) 124 tab_cntrl(31) = REAL(itau_dyn + itaufin) 122 125 c start_time: start_time of simulation (not necessarily 0.) 123 126 tab_cntrl(32) = start_time … … 165 168 . "Parametres de controle") 166 169 ierr = NF_ENDDEF(nid) 167 #ifdef NC_DOUBLE 168 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) 169 #else 170 ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl) 171 #endif 170 call NF95_PUT_VAR(nid,nvarid,tab_cntrl) 172 171 c 173 172 ierr = NF_REDEF (nid) … … 182 181 . "Longitudes des points U") 183 182 ierr = NF_ENDDEF(nid) 184 #ifdef NC_DOUBLE 185 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu) 186 #else 187 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu) 188 #endif 183 call NF95_PUT_VAR(nid,nvarid,rlonu) 189 184 c 190 185 ierr = NF_REDEF (nid) … … 199 194 . "Latitudes des points U") 200 195 ierr = NF_ENDDEF(nid) 201 #ifdef NC_DOUBLE 202 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu) 203 #else 204 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu) 205 #endif 196 call NF95_PUT_VAR (nid,nvarid,rlatu) 206 197 c 207 198 ierr = NF_REDEF (nid) … … 216 207 . "Longitudes des points V") 217 208 ierr = NF_ENDDEF(nid) 218 #ifdef NC_DOUBLE 219 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv) 220 #else 221 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv) 222 #endif 209 call NF95_PUT_VAR(nid,nvarid,rlonv) 223 210 c 224 211 ierr = NF_REDEF (nid) … … 233 220 . "Latitudes des points V") 234 221 ierr = NF_ENDDEF(nid) 235 #ifdef NC_DOUBLE 236 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv) 237 #else 238 ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv) 239 #endif 222 call NF95_PUT_VAR(nid,nvarid,rlatv) 240 223 c 241 224 ierr = NF_REDEF (nid) … … 250 233 . "Numero naturel des couches s") 251 234 ierr = NF_ENDDEF(nid) 252 #ifdef NC_DOUBLE 253 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs) 254 #else 255 ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs) 256 #endif 235 call NF95_PUT_VAR(nid,nvarid,nivsigs) 257 236 c 258 237 ierr = NF_REDEF (nid) … … 267 246 . "Numero naturel des couches sigma") 268 247 ierr = NF_ENDDEF(nid) 269 #ifdef NC_DOUBLE 270 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig) 271 #else 272 ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig) 273 #endif 248 call NF95_PUT_VAR(nid,nvarid,nivsig) 274 249 c 275 250 ierr = NF_REDEF (nid) … … 284 259 . "Coefficient A pour hybride") 285 260 ierr = NF_ENDDEF(nid) 286 #ifdef NC_DOUBLE 287 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap) 288 #else 289 ierr = NF_PUT_VAR_REAL (nid,nvarid,ap) 290 #endif 261 call NF95_PUT_VAR(nid,nvarid,ap) 291 262 c 292 263 ierr = NF_REDEF (nid) … … 301 272 . "Coefficient B pour hybride") 302 273 ierr = NF_ENDDEF(nid) 303 #ifdef NC_DOUBLE 304 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp) 305 #else 306 ierr = NF_PUT_VAR_REAL (nid,nvarid,bp) 307 #endif 274 call NF95_PUT_VAR(nid,nvarid,bp) 308 275 c 309 276 ierr = NF_REDEF (nid) … … 316 283 cIM 220306 END 317 284 ierr = NF_ENDDEF(nid) 318 #ifdef NC_DOUBLE 319 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs) 320 #else 321 ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs) 322 #endif 285 call NF95_PUT_VAR(nid,nvarid,presnivs) 323 286 c 324 287 c Coefficients de passage cov. <-> contra. <--> naturel … … 337 300 . "Coefficient de passage pour U") 338 301 ierr = NF_ENDDEF(nid) 339 #ifdef NC_DOUBLE 340 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu) 341 #else 342 ierr = NF_PUT_VAR_REAL (nid,nvarid,cu) 343 #endif 302 call NF95_PUT_VAR(nid,nvarid,cu) 344 303 c 345 304 ierr = NF_REDEF (nid) … … 356 315 . "Coefficient de passage pour V") 357 316 ierr = NF_ENDDEF(nid) 358 #ifdef NC_DOUBLE 359 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv) 360 #else 361 ierr = NF_PUT_VAR_REAL (nid,nvarid,cv) 362 #endif 317 call NF95_PUT_VAR(nid,nvarid,cv) 363 318 c 364 319 c Aire de chaque maille: … … 377 332 . "Aires de chaque maille") 378 333 ierr = NF_ENDDEF(nid) 379 #ifdef NC_DOUBLE 380 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire) 381 #else 382 ierr = NF_PUT_VAR_REAL (nid,nvarid,aire) 383 #endif 334 call NF95_PUT_VAR(nid,nvarid,aire) 384 335 c 385 336 c Geopentiel au sol: … … 398 349 . "Geopotentiel au sol") 399 350 ierr = NF_ENDDEF(nid) 400 #ifdef NC_DOUBLE 401 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis) 402 #else 403 ierr = NF_PUT_VAR_REAL (nid,nvarid,phis) 404 #endif 351 call NF95_PUT_VAR(nid,nvarid,phis) 405 352 c 406 353 c Definir les variables pour pouvoir les enregistrer plus tard: … … 510 457 ierr = NF_ENDDEF(nid) ! sortir du mode de definition 511 458 ierr = NF_CLOSE(nid) ! fermer le fichier 512 513 459 514 460 PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end … … 524 470 USE infotrac 525 471 USE control_mod 472 use netcdf, only: NF90_get_VAR 473 use netcdf95, only: NF95_PUT_VAR 474 526 475 IMPLICIT NONE 527 476 c================================================================= … … 536 485 #include "temps.h" 537 486 487 538 488 INTEGER l 539 REAL vcov(i p1jm,llm),ucov(ip1jmp1,llm)540 REAL teta(i p1jmp1,llm)541 REAL ps(i p1jmp1),masse(ip1jmp1,llm)542 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) 543 493 CHARACTER*(*) fichnom 544 494 … … 546 496 INTEGER nid, nvarid, nid_trac, nvarid_trac 547 497 REAL trac_tmp(ip1jmp1,llm) 548 INTEGER ierr, ierr_file 498 INTEGER ierr, ierr_file 549 499 INTEGER iq 550 500 INTEGER length … … 567 517 568 518 do iq=1,nqtot 569 call Gather_Field(q( 1,1,iq),ip1jmp1,llm,0)519 call Gather_Field(q(:,:,:,iq),ip1jmp1,llm,0) 570 520 enddo 571 521 … … 589 539 CALL abort_gcm(modname,abort_message,ierr) 590 540 ENDIF 591 #ifdef NC_DOUBLE 592 ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time) 593 #else 594 ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time) 595 #endif 541 call NF95_PUT_VAR(nid,nvarid,time,start=(/nb/)) 596 542 PRINT*, "Enregistrement pour ", nb, time 597 543 … … 605 551 CALL abort_gcm(modname,abort_message,ierr) 606 552 ENDIF 607 #ifdef NC_DOUBLE 608 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl) 609 #else 610 ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl) 611 #endif 612 tab_cntrl(31) = REAL(itau_dyn + itaufin) 613 #ifdef NC_DOUBLE 614 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) 615 #else 616 ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl) 617 #endif 553 ierr = NF90_GET_VAR(nid, nvarid, tab_cntrl) 554 tab_cntrl(31) = REAL(itau_dyn + itaufin) 555 call NF95_PUT_VAR(nid,nvarid,tab_cntrl) 618 556 619 557 c Ecriture des champs … … 624 562 CALL abort 625 563 ENDIF 626 #ifdef NC_DOUBLE 627 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov) 628 #else 629 ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov) 630 #endif 564 call NF95_PUT_VAR(nid,nvarid,ucov) 631 565 632 566 ierr = NF_INQ_VARID(nid, "vcov", nvarid) … … 635 569 CALL abort 636 570 ENDIF 637 #ifdef NC_DOUBLE 638 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov) 639 #else 640 ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov) 641 #endif 571 call NF95_PUT_VAR(nid,nvarid,vcov) 642 572 643 573 ierr = NF_INQ_VARID(nid, "teta", nvarid) … … 646 576 CALL abort 647 577 ENDIF 648 #ifdef NC_DOUBLE 649 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta) 650 #else 651 ierr = NF_PUT_VAR_REAL (nid,nvarid,teta) 652 #endif 578 call NF95_PUT_VAR(nid,nvarid,teta) 653 579 654 580 IF (type_trac == 'inca') THEN … … 675 601 CALL abort 676 602 ENDIF 677 #ifdef NC_DOUBLE 678 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) 679 #else 680 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 681 #endif 603 call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq)) 682 604 ELSE ! type_trac = inca 683 605 ! lecture de la valeur du traceur dans start_trac.nc … … 691 613 CALL abort 692 614 ENDIF 693 #ifdef NC_DOUBLE 694 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) 695 #else 696 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 697 #endif 615 call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq)) 698 616 699 617 ELSE 700 618 PRINT*, tname(iq), "est present dans start_trac.nc" 701 #ifdef NC_DOUBLE 702 ierr = NF_GET_VAR_DOUBLE(nid_trac, nvarid_trac, trac_tmp) 703 #else 704 ierr = NF_GET_VAR_REAL(nid_trac, nvarid_trac, trac_tmp) 705 #endif 619 ierr = NF90_GET_VAR(nid_trac, nvarid_trac, trac_tmp) 706 620 IF (ierr .NE. NF_NOERR) THEN 707 621 PRINT*, "Lecture echouee pour", tname(iq) … … 713 627 CALL abort 714 628 ENDIF 715 #ifdef NC_DOUBLE 716 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,trac_tmp) 717 #else 718 ierr = NF_PUT_VAR_REAL (nid,nvarid,trac_tmp) 719 #endif 629 call NF95_PUT_VAR(nid, nvarid, trac_tmp) 720 630 721 631 ENDIF ! IF (ierr .NE. NF_NOERR) … … 728 638 CALL abort 729 639 ENDIF 730 #ifdef NC_DOUBLE 731 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) 732 #else 733 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 734 #endif 640 call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq)) 735 641 ENDIF ! (ierr_file .ne. 2) 736 END IF ! 642 END IF !type_trac 737 643 738 644 ENDDO … … 746 652 CALL abort 747 653 ENDIF 748 #ifdef NC_DOUBLE 749 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse) 750 #else 751 ierr = NF_PUT_VAR_REAL (nid,nvarid,masse) 752 #endif 654 call NF95_PUT_VAR(nid,nvarid,masse) 753 655 c 754 656 ierr = NF_INQ_VARID(nid, "ps", nvarid) … … 757 659 CALL abort 758 660 ENDIF 759 #ifdef NC_DOUBLE 760 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps) 761 #else 762 ierr = NF_PUT_VAR_REAL (nid,nvarid,ps) 763 #endif 661 call NF95_PUT_VAR(nid,nvarid,ps) 764 662 765 663 ierr = NF_CLOSE(nid) -
trunk/LMDZ.COMMON/libf/dyn3dpar/etat0_netcdf.F90
r127 r776 1 1 ! 2 ! $Id: etat0_netcdf.F90 1 520 2011-05-23 11:37:09Z emillour$2 ! $Id: etat0_netcdf.F90 1625 2012-05-09 13:14:48Z lguez $ 3 3 ! 4 4 !------------------------------------------------------------------------------- … … 251 251 !******************************************************************************* 252 252 CALL pression(ip1jmp1, ap, bp, psol, p3d) 253 if ( disvert_type.eq.1) then253 if (pressure_exner) then 254 254 CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, y) 255 else ! we assume that we are in the disvert_type==2 case255 else 256 256 CALL exner_milieu(ip1jmp1,psol,p3d,beta,pks,pk,y) 257 257 endif -
trunk/LMDZ.COMMON/libf/dyn3dpar/exner_hyb.F
r127 r776 56 56 ! Sanity check 57 57 if (firstcall) then 58 ! check that vertical discretization is compatible59 ! with this routine60 if (disvert_type.ne.1) then61 call abort_gcm(modname,62 & "this routine should only be called if disvert_type==1",42)63 endif64 65 58 ! sanity checks for Shallow Water case (1 vertical layer) 66 59 if (llm.eq.1) then -
trunk/LMDZ.COMMON/libf/dyn3dpar/exner_hyb_p.F
r270 r776 60 60 ! Sanity check 61 61 if (firstcall) then 62 ! check that vertical discretization is compatible63 ! with this routine64 if (disvert_type.ne.1) then65 call abort_gcm(modname,66 & "this routine should only be called if disvert_type==1",42)67 endif68 69 62 ! sanity checks for Shallow Water case (1 vertical layer) 70 63 if (llm.eq.1) then -
trunk/LMDZ.COMMON/libf/dyn3dpar/exner_milieu.F
r127 r776 53 53 ! Sanity check 54 54 if (firstcall) then 55 ! check that vertical discretization is compatible56 ! with this routine57 if (disvert_type.ne.2) then58 call abort_gcm(modname,59 & "this routine should only be called if disvert_type==2",42)60 endif61 62 55 ! sanity checks for Shallow Water case (1 vertical layer) 63 56 if (llm.eq.1) then -
trunk/LMDZ.COMMON/libf/dyn3dpar/exner_milieu_p.F
r270 r776 56 56 ! Sanity check 57 57 if (firstcall) then 58 ! check that vertical discretization is compatible59 ! with this routine60 if (disvert_type.ne.2) then61 call abort_gcm(modname,62 & "this routine should only be called if disvert_type==2",42)63 endif64 65 58 ! sanity checks for Shallow Water case (1 vertical layer) 66 59 if (llm.eq.1) then -
trunk/LMDZ.COMMON/libf/dyn3dpar/gcm.F
r492 r776 20 20 USE control_mod 21 21 22 ! Ehouarn: for now these only apply to Earth:23 #ifdef CPP_ EARTH22 ! Ehouarn: the following are needed with (parallel) physics: 23 #ifdef CPP_PHYS 24 24 USE mod_grid_phy_lmdz 25 25 USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb … … 182 182 call ini_getparam("out.def") 183 183 call Read_Distrib 184 ! Ehouarn : temporarily (?) keep this only for Earth 185 ! if (planet_type.eq."earth") then 186 !#ifdef CPP_EARTH 184 187 185 #ifdef CPP_PHYS 188 186 CALL init_phys_lmdz(iim,jjp1,llm,mpi_size,distrib_phys) 189 187 #endif 190 ! endif ! of if (planet_type.eq."earth")191 188 CALL set_bands 192 189 #ifdef CPP_PHYS 193 ! Ehouarn: NB: For now only Earth physics is parallel194 190 CALL Init_interface_dyn_phys 195 191 #endif … … 203 199 c$OMP END PARALLEL 204 200 205 ! Ehouarn : temporarily (?) keep this only for Earth206 ! if (planet_type.eq."earth") then207 !#ifdef CPP_EARTH208 201 #ifdef CPP_PHYS 209 202 c$OMP PARALLEL … … 211 204 c$OMP END PARALLEL 212 205 #endif 213 ! endif ! of if (planet_type.eq."earth") 206 214 207 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 215 208 c … … 476 469 WRITE(lunout,*) 477 470 . 'GCM: WARNING!!! vitesse verticale nulle dans la physique' 478 479 ! Initialisation de la physique: pose probleme quand on tourne 480 ! SANS physique, car iniphysiq.F est dans le repertoire phy[]... 481 ! Il faut une cle CPP_PHYS 471 ! Physics 482 472 #ifdef CPP_PHYS 483 473 CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys , … … 486 476 call_iniphys=.false. 487 477 ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1)) 488 !#endif 478 489 479 490 480 c----------------------------------------------------------------------- … … 525 515 #endif 526 516 517 #ifdef CPP_PHYS 518 ! Create start file (startphy.nc) and boundary conditions (limit.nc) 519 ! for the Earth verstion 520 if (iflag_phys>=100) then 521 call iniaqua(ngridmx,latfi,lonfi,iflag_phys) 522 endif 523 #endif 524 527 525 if (planet_type.eq."mars") then 528 526 ! POUR MARS, METTRE UNE FONCTION A PART, genre dynredem0_mars -
trunk/LMDZ.COMMON/libf/dyn3dpar/gr_dyn_fi_p.F
r1 r776 1 1 ! 2 ! $Id: gr_dyn_fi_p.F 1 279 2009-12-10 09:02:56Z fairhead$2 ! $Id: gr_dyn_fi_p.F 1615 2012-02-10 15:42:26Z emillour $ 3 3 ! 4 4 SUBROUTINE gr_dyn_fi_p(nfield,im,jm,ngrid,pdyn,pfi) 5 #ifdef CPP_ EARTH5 #ifdef CPP_PHYS 6 6 ! Interface with parallel physics, 7 ! for now this routine only works with Earth physics8 7 USE mod_interface_dyn_phys 9 8 USE dimphy … … 40 39 ENDDO 41 40 c$OMP END DO NOWAIT 42 #else43 write(lunout,*) "gr_fi_dyn_p : This routine should not be called",44 & "without parallelized physics"45 stop46 41 #endif 47 ! of #ifdef CPP_ EARTH42 ! of #ifdef CPP_PHYS 48 43 RETURN 49 44 END -
trunk/LMDZ.COMMON/libf/dyn3dpar/gr_fi_dyn_p.F
r1 r776 1 1 ! 2 ! $Id: gr_fi_dyn_p.F 1 279 2009-12-10 09:02:56Z fairhead$2 ! $Id: gr_fi_dyn_p.F 1615 2012-02-10 15:42:26Z emillour $ 3 3 ! 4 4 SUBROUTINE gr_fi_dyn_p(nfield,ngrid,im,jm,pfi,pdyn) 5 #ifdef CPP_ EARTH5 #ifdef CPP_PHYS 6 6 ! Interface with parallel physics, 7 ! for now this routine only works with Earth physics8 7 USE mod_interface_dyn_phys 9 8 USE dimphy … … 52 51 ENDDO 53 52 c$OMP END DO NOWAIT 54 #else55 write(lunout,*) "gr_fi_dyn_p : This routine should not be called",56 & "without parallelized physics"57 stop58 53 #endif 59 ! of #ifdef CPP_ EARTH54 ! of #ifdef CPP_PHYS 60 55 RETURN 61 56 END -
trunk/LMDZ.COMMON/libf/dyn3dpar/guide_p_mod.F90
r127 r776 455 455 ! Calcul niveaux pression milieu de couches 456 456 CALL pression_p( ip1jmp1, ap, bp, ps, p ) 457 if ( disvert_type==1) then457 if (pressure_exner) then 458 458 CALL exner_hyb_p(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf) 459 459 else … … 755 755 ELSE 756 756 CALL pression_p( ip1jmp1, ap, bp, psi, p ) 757 if ( disvert_type==1) then757 if (pressure_exner) then 758 758 CALL exner_hyb_p(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf) 759 else ! we assume that we are in the disvert_type==2 case759 else 760 760 CALL exner_milieu_p(ip1jmp1,psi,p,beta,pks,pk,pkf) 761 761 endif -
trunk/LMDZ.COMMON/libf/dyn3dpar/iniacademic.F90
r492 r776 1 1 ! 2 ! $Id: iniacademic.F90 1 529 2011-05-26 15:17:33Z fairhead$2 ! $Id: iniacademic.F90 1625 2012-05-09 13:14:48Z lguez $ 3 3 ! 4 4 SUBROUTINE iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0) … … 222 222 223 223 CALL pression ( ip1jmp1, ap, bp, ps, p ) 224 if ( disvert_type.eq.1) then224 if (pressure_exner) then 225 225 CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf ) 226 else if (disvert_type.eq.2) then226 else 227 227 call exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf) 228 else229 write(abort_message,*) "Wrong value for disvert_type: ", &230 disvert_type231 call abort_gcm(modname,abort_message,0)232 228 endif 233 229 CALL massdair(p,masse) -
trunk/LMDZ.COMMON/libf/dyn3dpar/iniconst.F90
r775 r776 1 1 ! 2 ! $Id: iniconst.F 1520 2011-05-23 11:37:09Z emillour$2 ! $Id: iniconst.F90 1625 2012-05-09 13:14:48Z lguez $ 3 3 ! 4 4 SUBROUTINE iniconst 5 5 6 6 USE control_mod 7 7 #ifdef CPP_IOIPSL 8 8 use IOIPSL 9 9 #else 10 ! if not using IOIPSL, we still need to use (a local version of) getin11 10 ! if not using IOIPSL, we still need to use (a local version of) getin 11 use ioipsl_getincom 12 12 #endif 13 13 14 IMPLICIT NONE 15 c 16 c P. Le Van 17 c 18 c----------------------------------------------------------------------- 19 c Declarations: 20 c ------------- 21 c 22 #include "dimensions.h" 23 #include "paramet.h" 24 #include "comconst.h" 25 #include "temps.h" 26 #include "comvert.h" 27 #include "iniprint.h" 14 IMPLICIT NONE 15 ! 16 ! P. Le Van 17 ! 18 ! Declarations: 19 ! ------------- 20 ! 21 include "dimensions.h" 22 include "paramet.h" 23 include "comconst.h" 24 include "temps.h" 25 include "comvert.h" 26 include "iniprint.h" 28 27 28 character(len=*),parameter :: modname="iniconst" 29 character(len=80) :: abort_message 30 ! 31 ! 32 ! 33 !----------------------------------------------------------------------- 34 ! dimension des boucles: 35 ! ---------------------- 29 36 30 character(len=*),parameter :: modname="iniconst" 31 character(len=80) :: abort_message 32 c 33 c 34 c 35 c----------------------------------------------------------------------- 36 c dimension des boucles: 37 c ---------------------- 37 im = iim 38 jm = jjm 39 lllm = llm 40 imp1 = iim 41 jmp1 = jjm + 1 42 lllmm1 = llm - 1 43 lllmp1 = llm + 1 38 44 39 im = iim 40 jm = jjm 41 lllm = llm 42 imp1 = iim 43 jmp1 = jjm + 1 44 lllmm1 = llm - 1 45 lllmp1 = llm + 1 45 !----------------------------------------------------------------------- 46 46 47 c----------------------------------------------------------------------- 47 dtphys = iphysiq * dtvr 48 unsim = 1./iim 49 pi = 2.*ASIN( 1. ) 48 50 49 dtphys = iphysiq * dtvr 50 unsim = 1./iim 51 pi = 2.*ASIN( 1. ) 51 !----------------------------------------------------------------------- 52 ! 52 53 53 c----------------------------------------------------------------------- 54 c 54 r = cpp * kappa 55 55 56 r = cpp * kappa 56 write(lunout,*) trim(modname),': R CP Kappa ',r,cpp,kappa 57 ! 58 !----------------------------------------------------------------------- 57 59 58 write(lunout,*) trim(modname),': R CP Kappa ',r,cpp,kappa 59 c 60 c----------------------------------------------------------------------- 60 ! vertical discretization: default behavior depends on planet_type flag 61 if (planet_type=="earth") then 62 disvert_type=1 63 else 64 disvert_type=2 65 endif 66 ! but user can also specify using one or the other in run.def: 67 call getin('disvert_type',disvert_type) 68 write(lunout,*) trim(modname),': disvert_type=',disvert_type 61 69 62 ! vertical discretization: default behavior depends on planet_type flag 63 if (planet_type=="earth") then 64 disvert_type=1 65 else 66 disvert_type=2 67 endif 68 ! but user can also specify using one or the other in run.def: 69 call getin('disvert_type',disvert_type) 70 write(lunout,*) trim(modname),': disvert_type=',disvert_type 71 72 if (disvert_type==1) then 73 ! standard case for Earth (automatic generation of levels) 74 call disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig, 75 & scaleheight) 76 else if (disvert_type==2) then 77 ! standard case for planets (levels generated using z2sig.def file) 78 call disvert_noterre 79 else 80 write(abort_message,*) "Wrong value for disvert_type: ", 81 & disvert_type 82 call abort_gcm(modname,abort_message,0) 83 endif 70 pressure_exner = disvert_type == 1 ! default value 71 call getin('pressure_exner', pressure_exner) 84 72 85 END 73 if (disvert_type==1) then 74 ! standard case for Earth (automatic generation of levels) 75 call disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig, scaleheight) 76 else if (disvert_type==2) then 77 ! standard case for planets (levels generated using z2sig.def file) 78 call disvert_noterre 79 else 80 write(abort_message,*) "Wrong value for disvert_type: ", disvert_type 81 call abort_gcm(modname,abort_message,0) 82 endif 83 84 END SUBROUTINE iniconst -
trunk/LMDZ.COMMON/libf/dyn3dpar/inidissip.F90
r270 r776 28 28 ! Local variables: 29 29 REAL fact,zvert(llm),zz 30 REAL zh(ip1jmp1),zu(ip1jmp1),zv(ip1jm),deltap(ip1jmp1,llm) 30 REAL zh(ip1jmp1),zu(ip1jmp1), gx(ip1jmp1), divgra(ip1jmp1) 31 real zv(ip1jm), gy(ip1jm), deltap(ip1jmp1,llm) 31 32 REAL ullm,vllm,umin,vmin,zhmin,zhmax 32 REAL zllm ,z1llm33 REAL zllm 33 34 34 35 INTEGER l,ij,idum,ii … … 78 79 DO l = 1,50 79 80 IF(lstardis) THEN 80 CALL divgrad2(1,zh,deltap,niterh, zh)81 CALL divgrad2(1,zh,deltap,niterh,divgra) 81 82 ELSE 82 CALL divgrad (1,zh,niterh, zh)83 CALL divgrad (1,zh,niterh,divgra) 83 84 ENDIF 84 85 85 CALL minmax(iip1*jjp1,zh,zhmin,zhmax ) 86 87 zllm = ABS( zhmax ) 88 z1llm = 1./zllm 89 DO ij = 1,ip1jmp1 90 zh(ij) = zh(ij)* z1llm 91 ENDDO 86 zllm = ABS(maxval(divgra)) 87 zh = divgra / zllm 92 88 ENDDO 93 89 … … 123 119 !cccc CALL covcont( 1,zu,zv,zu,zv ) 124 120 IF(lstardis) THEN 125 CALL gradiv2( 1,zu,zv,nitergdiv, zu,zv)121 CALL gradiv2( 1,zu,zv,nitergdiv,gx,gy ) 126 122 ELSE 127 CALL gradiv ( 1,zu,zv,nitergdiv, zu,zv)123 CALL gradiv ( 1,zu,zv,nitergdiv,gx,gy ) 128 124 ENDIF 129 125 ELSE 130 126 IF(lstardis) THEN 131 CALL nxgraro2( 1,zu,zv,nitergrot, zu,zv)127 CALL nxgraro2( 1,zu,zv,nitergrot,gx,gy ) 132 128 ELSE 133 CALL nxgrarot( 1,zu,zv,nitergrot, zu,zv)129 CALL nxgrarot( 1,zu,zv,nitergrot,gx,gy ) 134 130 ENDIF 135 131 ENDIF 136 132 137 CALL minmax(iip1*jjp1,zu,umin,ullm ) 138 CALL minmax(iip1*jjm, zv,vmin,vllm ) 139 140 ullm = ABS ( ullm ) 141 vllm = ABS ( vllm ) 142 143 zllm = MAX( ullm,vllm ) 144 z1llm = 1./ zllm 145 DO ij = 1, ip1jmp1 146 zu(ij) = zu(ij)* z1llm 147 ENDDO 148 DO ij = 1, ip1jm 149 zv(ij) = zv(ij)* z1llm 150 ENDDO 133 zllm = max(abs(maxval(gx)), abs(maxval(gy))) 134 zu = gx / zllm 135 zv = gy / zllm 151 136 end DO 152 137 -
trunk/LMDZ.COMMON/libf/dyn3dpar/inigrads.F
r1 r776 9 9 implicit none 10 10 11 integer if,im,jm,lm,i,j,l ,lnblnk11 integer if,im,jm,lm,i,j,l 12 12 real x(im),y(jm),z(lm),fx,fy,fz,dt 13 13 real xmin,xmax,ymin,ymax … … 40 40 ivar(if)=0 41 41 42 fichier(if)= file(1:lnblnk(file))42 fichier(if)=trim(file) 43 43 44 44 firsttime(if)=.true. … … 70 70 71 71 print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if)) 72 print*, file(1:lnblnk(file))//'.dat'72 print*,trim(file)//'.dat' 73 73 74 OPEN (unit(if)+1,FILE= file(1:lnblnk(file))//'.dat'74 OPEN (unit(if)+1,FILE=trim(file)//'.dat' 75 75 s ,FORM='unformatted', 76 76 s ACCESS='direct' -
trunk/LMDZ.COMMON/libf/dyn3dpar/integrd_p.F
r270 r776 1 1 ! 2 ! $Id: integrd_p.F 1 550 2011-07-05 09:44:55Z lguez$2 ! $Id: integrd_p.F 1616 2012-02-17 11:59:00Z emillour $ 3 3 ! 4 4 SUBROUTINE integrd_p 5 5 $ ( nq,vcovm1,ucovm1,tetam1,psm1,massem1, 6 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis ,finvmaold)6 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis) !,finvmaold) 7 7 USE parallel 8 8 USE control_mod, only : planet_type … … 33 33 #include "temps.h" 34 34 #include "serre.h" 35 #include "iniprint.h" 35 36 36 37 c Arguments: 37 38 c ---------- 38 39 39 INTEGER nq 40 41 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm) 42 REAL q(ip1jmp1,llm,nq) 43 REAL ps0(ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1) 44 45 REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm) 46 REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1),massem1(ip1jmp1,llm) 47 48 REAL dv(ip1jm,llm),du(ip1jmp1,llm) 49 REAL dteta(ip1jmp1,llm),dp(ip1jmp1) 50 REAL dq(ip1jmp1,llm,nq), finvmaold(ip1jmp1,llm) 40 integer,intent(in) :: nq ! number of tracers to handle in this routine 41 real,intent(inout) :: vcov(ip1jm,llm) ! covariant meridional wind 42 real,intent(inout) :: ucov(ip1jmp1,llm) ! covariant zonal wind 43 real,intent(inout) :: teta(ip1jmp1,llm) ! potential temperature 44 real,intent(inout) :: q(ip1jmp1,llm,nq) ! advected tracers 45 real,intent(inout) :: ps0(ip1jmp1) ! surface pressure 46 real,intent(inout) :: masse(ip1jmp1,llm) ! atmospheric mass 47 real,intent(in) :: phis(ip1jmp1) ! ground geopotential !!! unused 48 ! values at previous time step 49 real,intent(inout) :: vcovm1(ip1jm,llm) 50 real,intent(inout) :: ucovm1(ip1jmp1,llm) 51 real,intent(inout) :: tetam1(ip1jmp1,llm) 52 real,intent(inout) :: psm1(ip1jmp1) 53 real,intent(inout) :: massem1(ip1jmp1,llm) 54 ! the tendencies to add 55 real,intent(in) :: dv(ip1jm,llm) 56 real,intent(in) :: du(ip1jmp1,llm) 57 real,intent(in) :: dteta(ip1jmp1,llm) 58 real,intent(in) :: dp(ip1jmp1) 59 real,intent(in) :: dq(ip1jmp1,llm,nq) !!! unused 60 ! real,intent(out) :: finvmaold(ip1jmp1,llm) !!! unused 51 61 52 62 c Local: … … 54 64 55 65 REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ),pscr(ip1jmp1) 56 REAL massescr( ip1jmp1,llm ), finvmasse(ip1jmp1,llm) 66 REAL massescr( ip1jmp1,llm ) 67 ! REAL finvmasse(ip1jmp1,llm) 57 68 REAL,SAVE :: p(ip1jmp1,llmp1) 58 69 REAL tpn,tps,tppn(iim),tpps(iim) … … 60 71 REAL,SAVE :: deltap( ip1jmp1,llm ) 61 72 62 INTEGER l,ij,iq 73 INTEGER l,ij,iq,i,j 63 74 64 75 REAL SSUM … … 126 137 127 138 IF( .NOT. checksum ) THEN 128 PRINT*,' Au point ij = ',stop_it, ' , pression sol neg. ' 129 & , ps(stop_it) 130 print *, ' dans integrd' 131 stop 1 139 write(lunout,*) "integrd: negative surface pressure ", 140 & ps(stop_it) 141 write(lunout,*) " at node ij =", stop_it 142 ! since ij=j+(i-1)*jjp1 , we have 143 j=modulo(stop_it,jjp1) 144 i=1+(stop_it-j)/jjp1 145 write(lunout,*) " lon = ",rlonv(i)*180./pi, " deg", 146 & " lat = ",rlatu(j)*180./pi, " deg" 132 147 ENDIF 133 148 … … 167 182 CALL massdair_p ( p , masse ) 168 183 169 c CALL SCOPY( ijp1llm , masse, 1, finvmasse, 1 ) 170 ijb=ij_begin 171 ije=ij_end 172 173 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 174 DO l = 1,llm 175 finvmasse(ijb:ije,l)=masse(ijb:ije,l) 176 ENDDO 177 c$OMP END DO NOWAIT 178 179 jjb=jj_begin 180 jje=jj_end 181 CALL filtreg_p( finvmasse,jjb,jje, jjp1, llm, -2, 2, .TRUE., 1 ) 184 ! Ehouarn : we don't use/need finvmaold and finvmasse, 185 ! so might as well not compute them 186 !c CALL SCOPY( ijp1llm , masse, 1, finvmasse, 1 ) 187 ! ijb=ij_begin 188 ! ije=ij_end 189 ! 190 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 191 ! DO l = 1,llm 192 ! finvmasse(ijb:ije,l)=masse(ijb:ije,l) 193 ! ENDDO 194 !c$OMP END DO NOWAIT 195 ! 196 ! jjb=jj_begin 197 ! jje=jj_end 198 ! CALL filtreg_p( finvmasse,jjb,jje, jjp1, llm, -2, 2, .TRUE., 1 ) 182 199 c 183 200 … … 330 347 ENDIF 331 348 332 c CALL SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 ) 333 334 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 335 DO l = 1, llm 336 finvmaold(ijb:ije,l)=finvmasse(ijb:ije,l) 337 ENDDO 338 c$OMP END DO NOWAIT 349 ! Ehouarn: forget about finvmaold 350 !c CALL SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 ) 351 ! 352 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 353 ! DO l = 1, llm 354 ! finvmaold(ijb:ije,l)=finvmasse(ijb:ije,l) 355 ! ENDDO 356 !c$OMP END DO NOWAIT 339 357 340 358 endif ! of if (planet_type.eq."earth") -
trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F
r500 r776 132 132 REAL SSUM 133 133 REAL time_0 134 REAL,SAVE :: finvmaold(ip1jmp1,llm)134 ! REAL,SAVE :: finvmaold(ip1jmp1,llm) 135 135 136 136 cym LOGICAL lafin … … 272 272 273 273 CALL pression ( ip1jmp1, ap, bp, ps, p ) 274 if ( disvert_type==1) then274 if (pressure_exner) then 275 275 CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf ) 276 else ! we assume that we are in the disvert_type==2 case276 else 277 277 CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf ) 278 278 endif … … 283 283 c et du parallelisme !! 284 284 285 1 CONTINUE 285 1 CONTINUE ! Matsuno Forward step begins here 286 286 287 287 jD_cur = jD_ref + day_ini - day_ref + & 288 & i nt (itau * dtvr / daysec)288 & itau/day_step 289 289 jH_cur = jH_ref + start_time + & 290 & (itau * dtvr / daysec - int(itau * dtvr / daysec))290 & mod(itau,day_step)/float(day_step) 291 291 if (jH_cur > 1.0 ) then 292 292 jD_cur = jD_cur +1. … … 324 324 psm1= ps 325 325 326 finvmaold = masse 327 CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 ) 326 ! Ehouarn: finvmaold is actually not used 327 ! finvmaold = masse 328 ! CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 ) 328 329 c$OMP END MASTER 329 330 c$OMP BARRIER … … 343 344 tetam1 (ijb:ije,l) = teta (ijb:ije,l) 344 345 massem1 (ijb:ije,l) = masse (ijb:ije,l) 345 finvmaold(ijb:ije,l)=masse(ijb:ije,l)346 ! finvmaold(ijb:ije,l)=masse(ijb:ije,l) 346 347 347 348 if (pole_sud) ije=ij_end-iip1 … … 353 354 354 355 355 CALL filtreg_p ( finvmaold ,jj_begin,jj_end,jjp1, 356 . llm, -2,2, .TRUE., 1 ) 356 ! Ehouarn: finvmaold not used 357 ! CALL filtreg_p ( finvmaold ,jj_begin,jj_end,jjp1, 358 ! . llm, -2,2, .TRUE., 1 ) 357 359 358 360 endif ! of if (FirstCaldyn) … … 370 372 cym call minmax(ijp1llm,q(:,:,3),zqmin,zqmax) 371 373 372 2 CONTINUE 374 2 CONTINUE ! Matsuno backward or leapfrog step begins here 373 375 374 376 c$OMP MASTER … … 515 517 call Register_SwapFieldHallo(phi,phi,ip1jmp1,llm, 516 518 & jj_Nb_caldyn,0,0,TestRequest) 517 call Register_SwapFieldHallo(finvmaold,finvmaold,ip1jmp1,llm,518 & jj_Nb_caldyn,0,0,TestRequest)519 ! call Register_SwapFieldHallo(finvmaold,finvmaold,ip1jmp1,llm, 520 ! & jj_Nb_caldyn,0,0,TestRequest) 519 521 520 522 do j=1,nqtot … … 616 618 call start_timer(timer_caldyn) 617 619 620 ! compute geopotential phi() 618 621 ! ADAPTATION GCM POUR CP(T) 619 622 ! CALL geopot_p ( ip1jmp1, teta , pk , pks, phis , phi ) … … 699 702 700 703 CALL integrd_p ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 , 701 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,702 $ finvmaold )704 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ) 705 ! $ finvmaold ) 703 706 704 707 IF ((planet_type.eq."titan").and.(tidal)) then … … 773 776 774 777 c$OMP BARRIER 775 if ( disvert_type==1) then778 if (pressure_exner) then 776 779 CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta,pks, pk, pkf ) 777 else ! we assume that we are in the disvert_type==2 case780 else 778 781 CALL exner_milieu_p( ip1jmp1, ps, p, beta, pks, pk, pkf ) 779 782 endif 780 783 c$OMP BARRIER 781 784 jD_cur = jD_ref + day_ini - day_ref 782 $ + i nt (itau * dtvr / daysec)785 $ + itau/day_step 783 786 jH_cur = jH_ref + start_time + & 784 & (itau * dtvr / daysec - int(itau * dtvr / daysec))787 & mod(itau,day_step)/float(day_step) 785 788 ! call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes) 786 789 if (jH_cur > 1.0 ) then … … 803 806 ! Ehouarn: be careful, diagedyn is Earth-specific (includes ../phylmd/..)! 804 807 IF (planet_type.eq."earth") THEN 808 #ifdef CPP_EARTH 805 809 CALL diagedyn(ztit,2,1,1,dtphys 806 810 & , ucov , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2)) 811 #endif 807 812 ENDIF 808 813 ENDIF … … 1131 1136 CALL pression_p ( ip1jmp1, ap, bp, ps, p ) 1132 1137 c$OMP BARRIER 1133 if ( disvert_type==1) then1138 if (pressure_exner) then 1134 1139 CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf ) 1135 else ! we assume that we are in the disvert_type==2 case1140 else 1136 1141 CALL exner_milieu_p( ip1jmp1, ps, p, beta, pks, pk, pkf ) 1137 1142 endif … … 1295 1300 c$OMP END DO NOWAIT 1296 1301 1302 if (1 == 0) then 1303 !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics 1304 !!! 2) should probably not be here anyway 1305 !!! but are kept for those who would want to revert to previous behaviour 1297 1306 c$OMP MASTER 1298 1307 DO ij = 1,iim … … 1305 1314 ENDDO 1306 1315 c$OMP END MASTER 1307 endif 1316 endif ! of if (1 == 0) 1317 endif ! of of (pole_nord) 1308 1318 1309 1319 if (pole_sud) then … … 1321 1331 c$OMP END DO NOWAIT 1322 1332 1333 if (1 == 0) then 1334 !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics 1335 !!! 2) should probably not be here anyway 1336 !!! but are kept for those who would want to revert to previous behaviour 1323 1337 c$OMP MASTER 1324 1338 DO ij = 1,iim … … 1331 1345 ENDDO 1332 1346 c$OMP END MASTER 1333 endif 1347 endif ! of if (1 == 0) 1348 endif ! of if (pole_sud) 1334 1349 1335 1350 -
trunk/LMDZ.COMMON/libf/dyn3dpar/mod_interface_dyn_phys.F90
r1 r776 1 1 ! 2 ! $Id: mod_interface_dyn_phys.F90 1 279 2009-12-10 09:02:56Z fairhead$2 ! $Id: mod_interface_dyn_phys.F90 1615 2012-02-10 15:42:26Z emillour $ 3 3 ! 4 4 MODULE mod_interface_dyn_phys … … 7 7 8 8 9 #ifdef CPP_ EARTH9 #ifdef CPP_PHYS 10 10 ! Interface with parallel physics, 11 ! for now this routine only works with Earth physics12 11 CONTAINS 13 12 … … 56 55 END SUBROUTINE Init_interface_dyn_phys 57 56 #endif 58 ! of #ifdef CPP_ EARTH57 ! of #ifdef CPP_PHYS 59 58 END MODULE mod_interface_dyn_phys -
trunk/LMDZ.COMMON/libf/dyn3dpar/wrgrads.F
r1 r776 17 17 integer if,nl 18 18 real field(imx*jmx*lmx) 19 20 integer, parameter:: wp = selected_real_kind(p=6, r=36) 21 real(wp) field4(imx*jmx*lmx) 22 19 23 character*10 name,file 20 24 character*10 titlevar … … 22 26 c local 23 27 24 integer im,jm,lm,i,j,l, lnblnk,iv,iii,iji,iif,ijf28 integer im,jm,lm,i,j,l,iv,iii,iji,iif,ijf 25 29 26 30 logical writectl … … 29 33 writectl=.false. 30 34 31 35 c print*,if,iid(if),jid(if),ifd(if),jfd(if) 32 36 iii=iid(if) 33 37 iji=jid(if) … … 38 42 lm=lmd(if) 39 43 40 41 44 c print*,'im,jm,lm,name,firsttime(if)' 45 c print*,im,jm,lm,name,firsttime(if) 42 46 43 47 if(firsttime(if)) then … … 55 59 nvar(if)=ivar(if) 56 60 var(ivar(if),if)=name 57 tvar(ivar(if),if)=t itlevar(1:lnblnk(titlevar))61 tvar(ivar(if),if)=trim(titlevar) 58 62 nld(ivar(if),if)=nl 59 60 63 c print*,'initialisation ecriture de ',var(ivar(if),if) 64 c print*,'if ivar(if) nld ',if,ivar(if),nld(ivar(if),if) 61 65 endif 62 66 writectl=.true. … … 81 85 endif 82 86 83 print*,'ivar(if),nvar(if),var(ivar(if),if),writectl' 84 print*,ivar(if),nvar(if),var(ivar(if),if),writectl 87 c print*,'ivar(if),nvar(if),var(ivar(if),if),writectl' 88 c print*,ivar(if),nvar(if),var(ivar(if),if),writectl 89 field4(1:imd(if)*jmd(if)*nl)=field(1:imd(if)*jmd(if)*nl) 85 90 do l=1,nl 86 91 irec(if)=irec(if)+1 … … 89 94 c s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif 90 95 write(unit(if)+1,rec=irec(if)) 91 s ((field ((l-1)*imd(if)*jmd(if)+(j-1)*imd(if)+i)96 s ((field4((l-1)*imd(if)*jmd(if)+(j-1)*imd(if)+i) 92 97 s ,i=iii,iif),j=iji,ijf) 93 98 enddo … … 96 101 file=fichier(if) 97 102 c WARNING! on reecrase le fichier .ctl a chaque ecriture 98 open(unit(if),file= file(1:lnblnk(file))//'.ctl'103 open(unit(if),file=trim(file)//'.ctl' 99 104 & ,form='formatted',status='unknown') 100 105 write(unit(if),'(a5,1x,a40)') 101 & 'DSET ','^'// file(1:lnblnk(file))//'.dat'106 & 'DSET ','^'//trim(file)//'.dat' 102 107 103 108 write(unit(if),'(a12)') 'UNDEF 1.0E30'
Note: See TracChangeset
for help on using the changeset viewer.
