Changeset 1323
- Timestamp:
- Mar 12, 2010, 5:19:12 PM (15 years ago)
- Location:
- LMDZ4/trunk/libf
- Files:
-
- 1 added
- 6 deleted
- 10 edited
-
bibio/assert_eq_m.F90 (modified) (1 diff)
-
dyn3d/ce0l.F90 (modified) (1 diff)
-
dyn3d/conf_gcm.F (modified) (1 diff)
-
dyn3d/etat0_netcdf.F90 (modified) (11 diffs)
-
dyn3d/inter_barx.F (deleted)
-
dyn3d/inter_barxy.F (deleted)
-
dyn3d/inter_barxy_m.F90 (added)
-
dyn3d/inter_bary.F (deleted)
-
dyn3d/limit_netcdf.F90 (modified) (5 diffs)
-
dyn3d/startvar.F90 (modified) (8 diffs)
-
dyn3dpar/conf_gcm.F (modified) (1 diff)
-
dyn3dpar/etat0_netcdf.F90 (modified) (11 diffs)
-
dyn3dpar/inter_barx.F (deleted)
-
dyn3dpar/inter_barxy.F (deleted)
-
dyn3dpar/inter_bary.F (deleted)
-
dyn3dpar/limit_netcdf.F90 (modified) (5 diffs)
-
dyn3dpar/startvar.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/bibio/assert_eq_m.F90
r1279 r1323 48 48 else 49 49 write (*,*) 'nrerror: an assert_eq failed with this tag: ', & 50 string 50 string,n1,n2,n3,n4 51 51 print *, 'program terminated by assert_eq4' 52 52 stop 1 -
LMDZ4/trunk/libf/dyn3d/ce0l.F90
r1319 r1323 5 5 ! 6 6 PROGRAM ce0l 7 !8 7 !------------------------------------------------------------------------------- 9 8 ! Purpose: Calls etat0, creates initial states and limit_netcdf -
LMDZ4/trunk/libf/dyn3d/conf_gcm.F
r1319 r1323 786 786 787 787 write(lunout,*)' #########################################' 788 write(lunout,*)' Configuration des parametres de c reate_etat0'788 write(lunout,*)' Configuration des parametres de cel0' 789 789 & //'_limit: ' 790 790 write(lunout,*)' planet_type = ', planet_type -
LMDZ4/trunk/libf/dyn3d/etat0_netcdf.F90
r1319 r1323 171 171 x='masque' 172 172 masque(:,:)=0.0 173 CALL startget (x, iip1, jjp1, rlonv, rlatu, masque, 0.0, jjm, rlonu,&174 173 CALL startget_phys2d(x, iip1, jjp1, rlonv, rlatu, masque, 0.0, jjm, & 174 & rlonu, rlatv, ib) 175 175 WRITE(lunout,*)'MASQUE construit : Masque' 176 176 WRITE(lunout,'(97I1)') nINT(masque) … … 179 179 WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1. 180 180 ELSE 181 WRITE(lunout,*)'ATTENTION!! fichier o2a.nc trouve' 182 WRITE(lunout,*)'Run couple' 181 183 couple=.true. 182 184 iret=NF90_CLOSE(nid_o2a) … … 189 191 &ean',1) 190 192 END IF 191 ALLOCATE( ocemask(iml_omask,jml_omask), ocetmp(iml_omask,jml_omask))192 ALLOCATE(lon_omask(iml_omask,jml_omask),lat_omask(iml_omask,jml_omask))193 ALLOCATE(dlon_omask(iml_omask),dlat_omask(jml_omask))194 CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp, &195 lon_omask, lat_omask, lev, ttm_tmp, itaul, date, dt, fid)196 CALL flinget(fid,'OceMask',iml_omask,jml_omask,llm_tmp,ttm_tmp,1,1,ocetmp)197 CALL flinclo(fid)198 dlon_omask(:)=lon_omask(:,1)199 dlat_omask(:)=lat_omask(1,:)200 ocemask=ocetmp201 IF(dlat_omask(1)<dlat_omask(jml_omask)) THEN202 DO j=1,jml_omask203 ocemask(:,j) = ocetmp(:,jml_omask-j+1)204 END DO205 END IF206 193 ALLOCATE( ocemask(iml_omask,jml_omask), ocetmp(iml_omask,jml_omask)) 207 194 ALLOCATE( lon_omask(iml_omask,jml_omask),lat_omask(iml_omask,jml_omask)) 208 195 ALLOCATE(dlon_omask(iml_omask), dlat_omask(jml_omask)) 209 CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp, lon_omask, 210 211 CALL flinget(fid, 'OceMask', iml_omask, jml_omask, llm_tmp, ttm_tmp, 212 196 CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp, lon_omask,& 197 & lat_omask, lev, ttm_tmp, itaul, date, dt, fid) 198 CALL flinget(fid, 'OceMask', iml_omask, jml_omask, llm_tmp, ttm_tmp, & 199 & 1, 1, ocetmp) 213 200 CALL flinclo(fid) 214 201 dlon_omask(1:iml_omask) = lon_omask(1:iml_omask,1) … … 237 224 ! values in the restart file 238 225 x = 'relief'; orog(:,:) = 0.0 239 CALL startget (x,iip1,jjp1,rlonv,rlatu,orog, 0.0,jjm,rlonu,rlatv,ib,&240 masque)226 CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu, orog, 0.0,jjm,rlonu,rlatv,ib,& 227 & masque) 241 228 242 229 x = 'rugosite'; rugo(:,:) = 0.0 243 CALL startget (x,iip1,jjp1,rlonv,rlatu,rugo, 0.0,jjm, rlonu,rlatv,ib)230 CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu, rugo, 0.0,jjm, rlonu,rlatv,ib) 244 231 ! WRITE(lunout,'(49I1)') INT(orog(:,:)*10) 245 232 ! WRITE(lunout,'(49I1)') INT(rugo(:,:)*10) … … 249 236 pctsrf=0. 250 237 x = 'psol'; psol(:,:) = 0.0 251 CALL startget (x,iip1,jjp1,rlonv,rlatu,psol,0.0,jjm,rlonu,rlatv,ib)238 CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu,psol,0.0,jjm,rlonu,rlatv,ib) 252 239 ! WRITE(lunout,*) 'PSOL :', psol(10,20) 253 240 ! WRITE(lunout,*) ap(:), bp(:) … … 263 250 264 251 x = 'surfgeo'; phis(:,:) = 0.0 265 CALL startget (x,iip1,jjp1,rlonv,rlatu,phis, 0.0,jjm, rlonu,rlatv,ib)252 CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu,phis, 0.0,jjm, rlonu,rlatv,ib) 266 253 267 254 x = 'u'; uvent(:,:,:) = 0.0 268 CALL startget(x,iip1,jjp1,rlonu,rlatu,llm,pls,y,uvent,0.0,jjm, rlonv,rlatv,ib) 255 CALL startget_dyn(x,rlonu,rlatu,pls,y,uvent,0.0, & 256 & rlonv,rlatv,ib) 269 257 270 258 x = 'v'; vvent(:,:,:) = 0.0 271 CALL startget(x,iip1,jjm, rlonv,rlatv,llm,pls,y,vvent,0.0,jjp1,rlonu,rlatu,ib) 259 CALL startget_dyn(x, rlonv,rlatv,pls(:, :jjm, :),y(:, :jjm, :),vvent,0.0, & 260 & rlonu,rlatu(:jjm),ib) 272 261 273 262 x = 't'; t3d(:,:,:) = 0.0 274 CALL startget(x,iip1,jjp1,rlonv,rlatu,llm,pls,y,t3d, 0.0,jjm, rlonu,rlatv,ib) 263 CALL startget_dyn(x,rlonv,rlatu,pls,y,t3d,0.0, & 264 & rlonu,rlatv,ib) 275 265 276 266 x = 'tpot'; tpot(:,:,:) = 0.0 277 CALL startget(x,iip1,jjp1,rlonv,rlatu,llm,pls,pk,tpot,0.0,jjm, rlonu,rlatv,ib) 267 CALL startget_dyn(x,rlonv,rlatu,pls,pk,tpot,0.0, & 268 & rlonu,rlatv,ib) 278 269 279 270 WRITE(lunout,*) 'T3D min,max:',minval(t3d(:,:,:)),maxval(t3d(:,:,:)) … … 289 280 290 281 x = 'q'; qd (:,:,:) = 0.0 291 CALL startget (x,iip1,jjp1,rlonv,rlatu,llm,pls,qsat,qd,0.0,jjm, rlonu,rlatv,ib)282 CALL startget_dyn(x,rlonv,rlatu,pls,qsat,qd,0.0, rlonu,rlatv,ib) 292 283 q3d(:,:,:,:) = 0.0 ; q3d(:,:,:,1) = qd(:,:,:) 293 284 … … 296 287 297 288 x = 'tsol'; tsol(:) = 0.0 298 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,tsol,0.0,jjm,rlonu,rlatv,ib)289 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,tsol,0.0,jjm,rlonu,rlatv,ib) 299 290 300 291 x = 'qsol'; qsol(:) = 0.0 301 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,qsol,0.0,jjm,rlonu,rlatv,ib)292 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,qsol,0.0,jjm,rlonu,rlatv,ib) 302 293 303 294 x = 'snow'; sn(:) = 0.0 304 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,sn,0.0,jjm,rlonu,rlatv,ib)295 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,sn,0.0,jjm,rlonu,rlatv,ib) 305 296 306 297 x = 'rads'; radsol(:) = 0.0 307 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0,jjm,rlonu,rlatv,ib)298 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0,jjm,rlonu,rlatv,ib) 308 299 309 300 x = 'rugmer'; rugmer(:) = 0.0 310 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0,jjm,rlonu,rlatv,ib)301 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0,jjm,rlonu,rlatv,ib) 311 302 312 303 x = 'zmea'; zmea(:) = 0.0 313 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,jjm,rlonu,rlatv,ib)304 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,jjm,rlonu,rlatv,ib) 314 305 315 306 x = 'zstd'; zstd(:) = 0.0 316 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,jjm,rlonu,rlatv,ib)307 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,jjm,rlonu,rlatv,ib) 317 308 318 309 x = 'zsig'; zsig(:) = 0.0 319 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,jjm,rlonu,rlatv,ib)310 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,jjm,rlonu,rlatv,ib) 320 311 321 312 x = 'zgam'; zgam(:) = 0.0 322 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,jjm,rlonu,rlatv,ib)313 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,jjm,rlonu,rlatv,ib) 323 314 324 315 x = 'zthe'; zthe(:) = 0.0 325 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,jjm,rlonu,rlatv,ib)316 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,jjm,rlonu,rlatv,ib) 326 317 327 318 x = 'zpic'; zpic(:) = 0.0 328 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,jjm,rlonu,rlatv,ib)319 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,jjm,rlonu,rlatv,ib) 329 320 330 321 x = 'zval'; zval(:) = 0.0 331 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,jjm,rlonu,rlatv,ib)322 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,jjm,rlonu,rlatv,ib) 332 323 333 324 ! WRITE(lunout,'(48I3)') 'TSOL :', INT(tsol(2:klon)-273) … … 339 330 ALLOCATE(dlat_lic(jml_lic), dlon_lic(iml_lic)) 340 331 ALLOCATE( fraclic(iml_lic,jml_lic)) 341 CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp, 342 lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid)332 CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp, & 333 & lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid) 343 334 CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp, 1,1, fraclic) 344 335 CALL flinclo(fid) … … 352 343 dlon_lic(:)=lon_lic(:,1) 353 344 dlat_lic(:)=lat_lic(1,:) 354 CALL grille_m( iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic, iim,jjp1, 355 345 CALL grille_m( iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic, iim,jjp1, & 346 & rlonv, rlatu, flic_tmp(1:iim,:) ) 356 347 flic_tmp(iip1,:)=flic_tmp(1,:) 357 348 … … 494 485 CALL phyredem( "startphy.nc" ) 495 486 496 WRITE(lunout,*)'CCCCCCCCCCCCCCCCCC REACTIVER SORTIE VISU DANS ETAT0'497 WRITE(lunout,*)'entree histclo'487 ! WRITE(lunout,*)'CCCCCCCCCCCCCCCCCC REACTIVER SORTIE VISU DANS ETAT0' 488 ! WRITE(lunout,*)'entree histclo' 498 489 CALL histclo() 499 490 -
LMDZ4/trunk/libf/dyn3d/limit_netcdf.F90
r1319 r1323 28 28 NF90_NOERR, NF90_NOWRITE, NF90_DOUBLE, NF90_GLOBAL, & 29 29 NF90_CLOBBER, NF90_ENDDEF, NF90_UNLIMITED 30 USE inter_barxy_m, only: inter_barxy 30 31 #endif 31 32 IMPLICIT NONE … … 327 328 !--- fields 328 329 INTEGER :: imdep, jmdep, lmdep ! dimensions of 'champ' 329 REAL, ALLOCATABLE, DIMENSION(: ) :: champ ! wanted field on initial grid330 REAL, ALLOCATABLE, DIMENSION(:,:) :: champ ! wanted field on initial grid 330 331 REAL, ALLOCATABLE, DIMENSION(:) :: yder, timeyear 331 332 REAL, DIMENSION(iim,jjp1) :: champint ! interpolated field … … 399 400 400 401 !--- GETTING THE FIELD AND INTERPOLATING IT ------------------------------------ 401 ALLOCATE(champ(imdep *jmdep),champtime(iim,jjp1,lmdep))402 ALLOCATE(champ(imdep,jmdep),champtime(iim,jjp1,lmdep)) 402 403 IF(extrp) ALLOCATE(work(imdep,jmdep)) 403 404 … … 422 423 END IF 423 424 IF(mode=='RUG') champ=LOG(champ) 424 CALL inter_barxy( imdep, jmdep-1, dlon, dlat, champ, iim, jjm, rlonu, &425 rlatv, jjp1,champint)425 CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim), & 426 rlatv, champint) 426 427 IF(mode=='RUG') THEN 427 428 champint=EXP(champint) … … 430 431 ELSE 431 432 SELECT CASE(mode) 432 CASE('RUG'); CALL rugosite(imdep, jmdep, dlon, dlat, champ, 433 CASE('RUG'); CALL rugosite(imdep, jmdep, dlon, dlat, champ, & 433 434 iim, jjp1, rlonv, rlatu, champint, mask) 434 CASE('SIC'); CALL sea_ice (imdep, jmdep, dlon, dlat, champ, 435 CASE('SIC'); CALL sea_ice (imdep, jmdep, dlon, dlat, champ, & 435 436 iim, jjp1, rlonv, rlatu, champint) 436 CASE('SST','ALB'); CALL grille_m(imdep, jmdep, dlon, dlat, champ, 437 CASE('SST','ALB'); CALL grille_m(imdep, jmdep, dlon, dlat, champ, & 437 438 iim, jjp1, rlonv, rlatu, champint) 438 439 END SELECT -
LMDZ4/trunk/libf/dyn3d/startvar.F90
r1319 r1323 20 20 ! 21 21 ! - A 1D variable on the physical grid : 22 ! CALL startget (varname, iml, jml, lon_in, lat_in, nbindex, &22 ! CALL startget_phys1d((varname, iml, jml, lon_in, lat_in, nbindex, & 23 23 ! champ, val_exp, jml2, lon_in2, lat_in2, ibar ) 24 24 ! 25 25 ! - A 2D variable on the dynamical grid : 26 ! CALL startget (varname, iml, jml, lon_in, lat_in, &26 ! CALL startget_phys2d(varname, iml, jml, lon_in, lat_in, & 27 27 ! champ, val_exp, jml2, lon_in2, lat_in2, ibar ) 28 28 ! 29 29 ! - A 3D variable on the dynamical grid : 30 ! CALL startget (varname, iml, jml, lon_in, lat_in, lml, pls, workvar, &30 ! CALL startget_dyn((varname, iml, jml, lon_in, lat_in, lml, pls, workvar, & 31 31 ! champ, val_exp, jml2, lon_in2, lat_in2, ibar ) 32 32 ! … … 54 54 55 55 PRIVATE 56 PUBLIC startget 57 INTERFACE startget58 MODULE PROCEDURE startget_phys1d, startget_phys2d, startget_dyn59 END INTERFACE56 PUBLIC startget_phys2d, startget_phys1d, startget_dyn 57 ! INTERFACE startget 58 ! MODULE PROCEDURE startget_phys1d, startget_phys2d, startget_dyn 59 ! END INTERFACE 60 60 61 61 REAL, SAVE :: deg2rad, pi … … 254 254 !------------------------------------------------------------------------------- 255 255 ! 256 SUBROUTINE startget_dyn(varname, iml, jml, lon_in, lat_in, lml, pls,workvar,& 257 champ, val_exp, jml2, lon_in2, lat_in2, ibar) 256 SUBROUTINE startget_dyn(varname, lon_in, lat_in, pls,workvar,& 257 champ, val_exp, lon_in2, lat_in2, ibar) 258 259 use assert_eq_m, only: assert_eq 260 261 258 262 !------------------------------------------------------------------------------- 259 263 ! Comment: … … 261 265 !------------------------------------------------------------------------------- 262 266 ! Arguments: 263 CHARACTER(LEN=*), INTENT(IN) :: varname 264 INTEGER, INTENT(IN) :: iml, jml 265 REAL, DIMENSION(iml), INTENT(IN) :: lon_in 266 REAL, DIMENSION(jml), INTENT(IN) :: lat_in 267 INTEGER, INTENT(IN) :: lml 268 REAL, DIMENSION(iml,jml,lml), INTENT(IN) :: pls, workvar 269 REAL, DIMENSION(iml,jml,lml), INTENT(INOUT) :: champ 270 REAL, INTENT(IN) :: val_exp 271 INTEGER, INTENT(IN) :: jml2 272 REAL, DIMENSION(iml), INTENT(IN) :: lon_in2 273 REAL, DIMENSION(jml2), INTENT(IN) :: lat_in2 267 CHARACTER(LEN=*), INTENT(IN) :: varname 268 REAL, INTENT(IN) :: lon_in(:) ! dim(iml) 269 REAL, INTENT(IN) :: lat_in(:) ! dim(jml) 270 REAL, INTENT(IN) :: pls(:, :, :) ! dim(iml, jml, lml) 271 REAL, INTENT(IN) :: workvar(:, :, :) ! dim(iml, jml, lml) 272 REAL, INTENT(INOUT) :: champ(:, :, :) ! dim(iml, jml, lml) 273 REAL, INTENT(IN) :: val_exp 274 REAL, INTENT(IN) :: lon_in2(:) ! dim(iml) 275 REAL, INTENT(IN) :: lat_in2(:) ! dim(jml2) 274 276 LOGICAL, INTENT(IN) :: ibar 275 277 !------------------------------------------------------------------------------- … … 280 282 #include "paramet.h" 281 283 #include "comgeom2.h" 284 INTEGER :: iml, jml 285 INTEGER :: lml 286 INTEGER :: jml2 282 287 REAL, DIMENSION(:,:,:), POINTER :: v3d=>NULL() 283 288 CHARACTER(LEN=10) :: vname … … 287 292 NULLIFY(v3d) 288 293 IF(MINVAL(champ)==MAXVAL(champ).AND.MINVAL(champ)==val_exp) THEN 294 295 iml = assert_eq((/size(lon_in), size(pls, 1), size(workvar, 1), & 296 & size(champ, 1), size(lon_in2)/), "startget_dyn iml") 297 jml = assert_eq(size(lat_in), size(pls, 2), size(workvar, 2), & 298 & size(champ, 2), "startget_dyn jml") 299 lml = assert_eq(size(pls, 3), size(workvar, 3), size(champ, 3), & 300 & "startget_dyn lml") 301 jml2 = size(lat_in2) 289 302 290 303 !--- READING UNALLOCATED FILES … … 723 736 ! 724 737 !------------------------------------------------------------------------------- 738 739 USE inter_barxy_m, only: inter_barxy 740 725 741 ! Arguments: 726 742 CHARACTER(LEN=*), INTENT(IN) :: vname … … 750 766 '---------------------------------------------------------------' 751 767 END IF 752 CALL inter_barxy( ii, jj-1, lon, lat, vari, i1-1, j2, lon2, lat2, j1, vtmp)768 CALL inter_barxy(lon, lat(:jj-1), vari, lon2(:i1-1), lat2(:j2), vtmp) 753 769 ELSE 754 770 CALL grille_m (ii, jj, lon, lat, vari, i1-1, j1, lon1, lat1, vtmp) -
LMDZ4/trunk/libf/dyn3dpar/conf_gcm.F
r1319 r1323 832 832 833 833 write(lunout,*)' #########################################' 834 write(lunout,*)' Configuration des parametres de c reate_etat0'834 write(lunout,*)' Configuration des parametres de cel0' 835 835 & //'_limit: ' 836 836 write(lunout,*)' planet_type = ', planet_type -
LMDZ4/trunk/libf/dyn3dpar/etat0_netcdf.F90
r1319 r1323 171 171 x='masque' 172 172 masque(:,:)=0.0 173 CALL startget (x, iip1, jjp1, rlonv, rlatu, masque, 0.0, jjm, rlonu,&174 173 CALL startget_phys2d(x, iip1, jjp1, rlonv, rlatu, masque, 0.0, jjm, & 174 & rlonu, rlatv, ib) 175 175 WRITE(lunout,*)'MASQUE construit : Masque' 176 176 WRITE(lunout,'(97I1)') nINT(masque) … … 179 179 WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1. 180 180 ELSE 181 WRITE(lunout,*)'ATTENTION!! fichier o2a.nc trouve' 182 WRITE(lunout,*)'Run couple' 181 183 couple=.true. 182 184 iret=NF90_CLOSE(nid_o2a) … … 189 191 &ean',1) 190 192 END IF 191 ALLOCATE( ocemask(iml_omask,jml_omask), ocetmp(iml_omask,jml_omask))192 ALLOCATE(lon_omask(iml_omask,jml_omask),lat_omask(iml_omask,jml_omask))193 ALLOCATE(dlon_omask(iml_omask),dlat_omask(jml_omask))194 CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp, &195 lon_omask, lat_omask, lev, ttm_tmp, itaul, date, dt, fid)196 CALL flinget(fid,'OceMask',iml_omask,jml_omask,llm_tmp,ttm_tmp,1,1,ocetmp)197 CALL flinclo(fid)198 dlon_omask(:)=lon_omask(:,1)199 dlat_omask(:)=lat_omask(1,:)200 ocemask=ocetmp201 IF(dlat_omask(1)<dlat_omask(jml_omask)) THEN202 DO j=1,jml_omask203 ocemask(:,j) = ocetmp(:,jml_omask-j+1)204 END DO205 END IF206 193 ALLOCATE( ocemask(iml_omask,jml_omask), ocetmp(iml_omask,jml_omask)) 207 194 ALLOCATE( lon_omask(iml_omask,jml_omask),lat_omask(iml_omask,jml_omask)) 208 195 ALLOCATE(dlon_omask(iml_omask), dlat_omask(jml_omask)) 209 CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp, lon_omask, 210 211 CALL flinget(fid, 'OceMask', iml_omask, jml_omask, llm_tmp, ttm_tmp, 212 196 CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp, lon_omask,& 197 & lat_omask, lev, ttm_tmp, itaul, date, dt, fid) 198 CALL flinget(fid, 'OceMask', iml_omask, jml_omask, llm_tmp, ttm_tmp, & 199 & 1, 1, ocetmp) 213 200 CALL flinclo(fid) 214 201 dlon_omask(1:iml_omask) = lon_omask(1:iml_omask,1) … … 237 224 ! values in the restart file 238 225 x = 'relief'; orog(:,:) = 0.0 239 CALL startget (x,iip1,jjp1,rlonv,rlatu,orog, 0.0,jjm,rlonu,rlatv,ib,&240 masque)226 CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu, orog, 0.0,jjm,rlonu,rlatv,ib,& 227 & masque) 241 228 242 229 x = 'rugosite'; rugo(:,:) = 0.0 243 CALL startget (x,iip1,jjp1,rlonv,rlatu,rugo, 0.0,jjm, rlonu,rlatv,ib)230 CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu, rugo, 0.0,jjm, rlonu,rlatv,ib) 244 231 ! WRITE(lunout,'(49I1)') INT(orog(:,:)*10) 245 232 ! WRITE(lunout,'(49I1)') INT(rugo(:,:)*10) … … 249 236 pctsrf=0. 250 237 x = 'psol'; psol(:,:) = 0.0 251 CALL startget (x,iip1,jjp1,rlonv,rlatu,psol,0.0,jjm,rlonu,rlatv,ib)238 CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu,psol,0.0,jjm,rlonu,rlatv,ib) 252 239 ! WRITE(lunout,*) 'PSOL :', psol(10,20) 253 240 ! WRITE(lunout,*) ap(:), bp(:) … … 263 250 264 251 x = 'surfgeo'; phis(:,:) = 0.0 265 CALL startget (x,iip1,jjp1,rlonv,rlatu,phis, 0.0,jjm, rlonu,rlatv,ib)252 CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu,phis, 0.0,jjm, rlonu,rlatv,ib) 266 253 267 254 x = 'u'; uvent(:,:,:) = 0.0 268 CALL startget(x,iip1,jjp1,rlonu,rlatu,llm,pls,y,uvent,0.0,jjm, rlonv,rlatv,ib) 255 CALL startget_dyn(x,rlonu,rlatu,pls,y,uvent,0.0, & 256 & rlonv,rlatv,ib) 269 257 270 258 x = 'v'; vvent(:,:,:) = 0.0 271 CALL startget(x,iip1,jjm, rlonv,rlatv,llm,pls,y,vvent,0.0,jjp1,rlonu,rlatu,ib) 259 CALL startget_dyn(x, rlonv,rlatv,pls(:, :jjm, :),y(:, :jjm, :),vvent,0.0, & 260 & rlonu,rlatu(:jjm),ib) 272 261 273 262 x = 't'; t3d(:,:,:) = 0.0 274 CALL startget(x,iip1,jjp1,rlonv,rlatu,llm,pls,y,t3d, 0.0,jjm, rlonu,rlatv,ib) 263 CALL startget_dyn(x,rlonv,rlatu,pls,y,t3d,0.0, & 264 & rlonu,rlatv,ib) 275 265 276 266 x = 'tpot'; tpot(:,:,:) = 0.0 277 CALL startget(x,iip1,jjp1,rlonv,rlatu,llm,pls,pk,tpot,0.0,jjm, rlonu,rlatv,ib) 267 CALL startget_dyn(x,rlonv,rlatu,pls,pk,tpot,0.0, & 268 & rlonu,rlatv,ib) 278 269 279 270 WRITE(lunout,*) 'T3D min,max:',minval(t3d(:,:,:)),maxval(t3d(:,:,:)) … … 289 280 290 281 x = 'q'; qd (:,:,:) = 0.0 291 CALL startget (x,iip1,jjp1,rlonv,rlatu,llm,pls,qsat,qd,0.0,jjm, rlonu,rlatv,ib)282 CALL startget_dyn(x,rlonv,rlatu,pls,qsat,qd,0.0, rlonu,rlatv,ib) 292 283 q3d(:,:,:,:) = 0.0 ; q3d(:,:,:,1) = qd(:,:,:) 293 284 … … 296 287 297 288 x = 'tsol'; tsol(:) = 0.0 298 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,tsol,0.0,jjm,rlonu,rlatv,ib)289 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,tsol,0.0,jjm,rlonu,rlatv,ib) 299 290 300 291 x = 'qsol'; qsol(:) = 0.0 301 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,qsol,0.0,jjm,rlonu,rlatv,ib)292 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,qsol,0.0,jjm,rlonu,rlatv,ib) 302 293 303 294 x = 'snow'; sn(:) = 0.0 304 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,sn,0.0,jjm,rlonu,rlatv,ib)295 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,sn,0.0,jjm,rlonu,rlatv,ib) 305 296 306 297 x = 'rads'; radsol(:) = 0.0 307 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0,jjm,rlonu,rlatv,ib)298 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0,jjm,rlonu,rlatv,ib) 308 299 309 300 x = 'rugmer'; rugmer(:) = 0.0 310 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0,jjm,rlonu,rlatv,ib)301 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0,jjm,rlonu,rlatv,ib) 311 302 312 303 x = 'zmea'; zmea(:) = 0.0 313 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,jjm,rlonu,rlatv,ib)304 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,jjm,rlonu,rlatv,ib) 314 305 315 306 x = 'zstd'; zstd(:) = 0.0 316 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,jjm,rlonu,rlatv,ib)307 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,jjm,rlonu,rlatv,ib) 317 308 318 309 x = 'zsig'; zsig(:) = 0.0 319 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,jjm,rlonu,rlatv,ib)310 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,jjm,rlonu,rlatv,ib) 320 311 321 312 x = 'zgam'; zgam(:) = 0.0 322 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,jjm,rlonu,rlatv,ib)313 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,jjm,rlonu,rlatv,ib) 323 314 324 315 x = 'zthe'; zthe(:) = 0.0 325 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,jjm,rlonu,rlatv,ib)316 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,jjm,rlonu,rlatv,ib) 326 317 327 318 x = 'zpic'; zpic(:) = 0.0 328 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,jjm,rlonu,rlatv,ib)319 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,jjm,rlonu,rlatv,ib) 329 320 330 321 x = 'zval'; zval(:) = 0.0 331 CALL startget (x,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,jjm,rlonu,rlatv,ib)322 CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,jjm,rlonu,rlatv,ib) 332 323 333 324 ! WRITE(lunout,'(48I3)') 'TSOL :', INT(tsol(2:klon)-273) … … 339 330 ALLOCATE(dlat_lic(jml_lic), dlon_lic(iml_lic)) 340 331 ALLOCATE( fraclic(iml_lic,jml_lic)) 341 CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp, 342 lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid)332 CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp, & 333 & lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid) 343 334 CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp, 1,1, fraclic) 344 335 CALL flinclo(fid) … … 352 343 dlon_lic(:)=lon_lic(:,1) 353 344 dlat_lic(:)=lat_lic(1,:) 354 CALL grille_m( iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic, iim,jjp1, 355 345 CALL grille_m( iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic, iim,jjp1, & 346 & rlonv, rlatu, flic_tmp(1:iim,:) ) 356 347 flic_tmp(iip1,:)=flic_tmp(1,:) 357 348 … … 494 485 CALL phyredem( "startphy.nc" ) 495 486 496 WRITE(lunout,*)'CCCCCCCCCCCCCCCCCC REACTIVER SORTIE VISU DANS ETAT0'497 WRITE(lunout,*)'entree histclo'487 ! WRITE(lunout,*)'CCCCCCCCCCCCCCCCCC REACTIVER SORTIE VISU DANS ETAT0' 488 ! WRITE(lunout,*)'entree histclo' 498 489 CALL histclo() 499 490 -
LMDZ4/trunk/libf/dyn3dpar/limit_netcdf.F90
r1319 r1323 28 28 NF90_NOERR, NF90_NOWRITE, NF90_DOUBLE, NF90_GLOBAL, & 29 29 NF90_CLOBBER, NF90_ENDDEF, NF90_UNLIMITED 30 USE inter_barxy_m, only: inter_barxy 30 31 #endif 31 32 IMPLICIT NONE … … 327 328 !--- fields 328 329 INTEGER :: imdep, jmdep, lmdep ! dimensions of 'champ' 329 REAL, ALLOCATABLE, DIMENSION(: ) :: champ ! wanted field on initial grid330 REAL, ALLOCATABLE, DIMENSION(:,:) :: champ ! wanted field on initial grid 330 331 REAL, ALLOCATABLE, DIMENSION(:) :: yder, timeyear 331 332 REAL, DIMENSION(iim,jjp1) :: champint ! interpolated field … … 399 400 400 401 !--- GETTING THE FIELD AND INTERPOLATING IT ------------------------------------ 401 ALLOCATE(champ(imdep *jmdep),champtime(iim,jjp1,lmdep))402 ALLOCATE(champ(imdep,jmdep),champtime(iim,jjp1,lmdep)) 402 403 IF(extrp) ALLOCATE(work(imdep,jmdep)) 403 404 … … 422 423 END IF 423 424 IF(mode=='RUG') champ=LOG(champ) 424 CALL inter_barxy( imdep, jmdep-1, dlon, dlat, champ, iim, jjm, rlonu, &425 rlatv, jjp1,champint)425 CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim), & 426 rlatv, champint) 426 427 IF(mode=='RUG') THEN 427 428 champint=EXP(champint) … … 430 431 ELSE 431 432 SELECT CASE(mode) 432 CASE('RUG'); CALL rugosite(imdep, jmdep, dlon, dlat, champ, 433 CASE('RUG'); CALL rugosite(imdep, jmdep, dlon, dlat, champ, & 433 434 iim, jjp1, rlonv, rlatu, champint, mask) 434 CASE('SIC'); CALL sea_ice (imdep, jmdep, dlon, dlat, champ, 435 CASE('SIC'); CALL sea_ice (imdep, jmdep, dlon, dlat, champ, & 435 436 iim, jjp1, rlonv, rlatu, champint) 436 CASE('SST','ALB'); CALL grille_m(imdep, jmdep, dlon, dlat, champ, 437 CASE('SST','ALB'); CALL grille_m(imdep, jmdep, dlon, dlat, champ, & 437 438 iim, jjp1, rlonv, rlatu, champint) 438 439 END SELECT -
LMDZ4/trunk/libf/dyn3dpar/startvar.F90
r1319 r1323 20 20 ! 21 21 ! - A 1D variable on the physical grid : 22 ! CALL startget (varname, iml, jml, lon_in, lat_in, nbindex, &22 ! CALL startget_phys1d((varname, iml, jml, lon_in, lat_in, nbindex, & 23 23 ! champ, val_exp, jml2, lon_in2, lat_in2, ibar ) 24 24 ! 25 25 ! - A 2D variable on the dynamical grid : 26 ! CALL startget (varname, iml, jml, lon_in, lat_in, &26 ! CALL startget_phys2d(varname, iml, jml, lon_in, lat_in, & 27 27 ! champ, val_exp, jml2, lon_in2, lat_in2, ibar ) 28 28 ! 29 29 ! - A 3D variable on the dynamical grid : 30 ! CALL startget (varname, iml, jml, lon_in, lat_in, lml, pls, workvar, &30 ! CALL startget_dyn((varname, iml, jml, lon_in, lat_in, lml, pls, workvar, & 31 31 ! champ, val_exp, jml2, lon_in2, lat_in2, ibar ) 32 32 ! … … 54 54 55 55 PRIVATE 56 PUBLIC startget 57 INTERFACE startget58 MODULE PROCEDURE startget_phys1d, startget_phys2d, startget_dyn59 END INTERFACE56 PUBLIC startget_phys2d, startget_phys1d, startget_dyn 57 ! INTERFACE startget 58 ! MODULE PROCEDURE startget_phys1d, startget_phys2d, startget_dyn 59 ! END INTERFACE 60 60 61 61 REAL, SAVE :: deg2rad, pi … … 254 254 !------------------------------------------------------------------------------- 255 255 ! 256 SUBROUTINE startget_dyn(varname, iml, jml, lon_in, lat_in, lml, pls,workvar,& 257 champ, val_exp, jml2, lon_in2, lat_in2, ibar) 256 SUBROUTINE startget_dyn(varname, lon_in, lat_in, pls,workvar,& 257 champ, val_exp, lon_in2, lat_in2, ibar) 258 259 use assert_eq_m, only: assert_eq 260 261 258 262 !------------------------------------------------------------------------------- 259 263 ! Comment: … … 261 265 !------------------------------------------------------------------------------- 262 266 ! Arguments: 263 CHARACTER(LEN=*), INTENT(IN) :: varname 264 INTEGER, INTENT(IN) :: iml, jml 265 REAL, DIMENSION(iml), INTENT(IN) :: lon_in 266 REAL, DIMENSION(jml), INTENT(IN) :: lat_in 267 INTEGER, INTENT(IN) :: lml 268 REAL, DIMENSION(iml,jml,lml), INTENT(IN) :: pls, workvar 269 REAL, DIMENSION(iml,jml,lml), INTENT(INOUT) :: champ 270 REAL, INTENT(IN) :: val_exp 271 INTEGER, INTENT(IN) :: jml2 272 REAL, DIMENSION(iml), INTENT(IN) :: lon_in2 273 REAL, DIMENSION(jml2), INTENT(IN) :: lat_in2 267 CHARACTER(LEN=*), INTENT(IN) :: varname 268 REAL, INTENT(IN) :: lon_in(:) ! dim(iml) 269 REAL, INTENT(IN) :: lat_in(:) ! dim(jml) 270 REAL, INTENT(IN) :: pls(:, :, :) ! dim(iml, jml, lml) 271 REAL, INTENT(IN) :: workvar(:, :, :) ! dim(iml, jml, lml) 272 REAL, INTENT(INOUT) :: champ(:, :, :) ! dim(iml, jml, lml) 273 REAL, INTENT(IN) :: val_exp 274 REAL, INTENT(IN) :: lon_in2(:) ! dim(iml) 275 REAL, INTENT(IN) :: lat_in2(:) ! dim(jml2) 274 276 LOGICAL, INTENT(IN) :: ibar 275 277 !------------------------------------------------------------------------------- … … 280 282 #include "paramet.h" 281 283 #include "comgeom2.h" 284 INTEGER :: iml, jml 285 INTEGER :: lml 286 INTEGER :: jml2 282 287 REAL, DIMENSION(:,:,:), POINTER :: v3d=>NULL() 283 288 CHARACTER(LEN=10) :: vname … … 287 292 NULLIFY(v3d) 288 293 IF(MINVAL(champ)==MAXVAL(champ).AND.MINVAL(champ)==val_exp) THEN 294 295 iml = assert_eq((/size(lon_in), size(pls, 1), size(workvar, 1), & 296 & size(champ, 1), size(lon_in2)/), "startget_dyn iml") 297 jml = assert_eq(size(lat_in), size(pls, 2), size(workvar, 2), & 298 & size(champ, 2), "startget_dyn jml") 299 lml = assert_eq(size(pls, 3), size(workvar, 3), size(champ, 3), & 300 & "startget_dyn lml") 301 jml2 = size(lat_in2) 289 302 290 303 !--- READING UNALLOCATED FILES … … 723 736 ! 724 737 !------------------------------------------------------------------------------- 738 739 USE inter_barxy_m, only: inter_barxy 740 725 741 ! Arguments: 726 742 CHARACTER(LEN=*), INTENT(IN) :: vname … … 750 766 '---------------------------------------------------------------' 751 767 END IF 752 CALL inter_barxy( ii, jj-1, lon, lat, vari, i1-1, j2, lon2, lat2, j1, vtmp)768 CALL inter_barxy(lon, lat(:jj-1), vari, lon2(:i1-1), lat2(:j2), vtmp) 753 769 ELSE 754 770 CALL grille_m (ii, jj, lon, lat, vari, i1-1, j1, lon1, lat1, vtmp)
Note: See TracChangeset
for help on using the changeset viewer.
