Changeset 1328 for LMDZ4/trunk/libf
- Timestamp:
- Mar 18, 2010, 2:26:23 PM (15 years ago)
- Location:
- LMDZ4/trunk/libf
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/dyn3d/etat0_netcdf.F90
r1323 r1328 214 214 WRITE(lunout,fmt)int(ocemask) 215 215 ocemask_fi(1)=ocemask(1,1) 216 DO j=2,jjm; ocemask_fi((j-2)*iim+ 1:iim+1)=ocemask(1:iim,j); END DO216 DO j=2,jjm; ocemask_fi((j-2)*iim+2:(j-1)*iim+1)=ocemask(1:iim,j); END DO 217 217 ocemask_fi(klon)=ocemask(1,jjp1) 218 218 zmasq=1.-ocemask_fi -
LMDZ4/trunk/libf/dyn3d/limit_netcdf.F90
r1323 r1328 81 81 INTEGER :: NF90_FORMAT 82 82 LOGICAL :: lCPL !--- T: IPCC-IPSL cpl model output files 83 84 !--- MICS (PHYSICAL KEYS, TIME) ------------------------------------------------ 85 ! INTEGER, PARAMETER :: longcles=20 86 ! REAL, DIMENSION(longcles) :: clesphy0 87 INTEGER :: ndays 88 83 INTEGER :: ndays !--- Depending on the output calendar 84 89 85 !--- INITIALIZATIONS ----------------------------------------------------------- 90 86 #ifdef NC_DOUBLE … … 94 90 #endif 95 91 96 ! CALL conf_gcm(99, .TRUE., clesphy0)97 92 pi = 4.*ATAN(1.) 98 93 rad = 6371229. … … 129 124 WRITE(lunout,*)'Pour la glace de mer a ete choisi un fichier '//TRIM(dumstr) 130 125 131 CALL get_2Dfield(icefile,'SIC',interbar,ndays,phy_ice,flag=oldice )126 CALL get_2Dfield(icefile,'SIC',interbar,ndays,phy_ice,flag=oldice,lCPL=lCPL) 132 127 133 128 ALLOCATE(pctsrf_t(klon,nbsrf,ndays)) … … 139 134 pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter) ! land soil 140 135 pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic) ! land ice 141 IF(lCPL) THEN ! SIC=pICE*(1-LIC-TER)136 IF(lCPL) THEN ! SIC=pICE*(1-LIC-TER) 142 137 pctsrf_t(:,is_sic,k)=fi_ice*(1-pctsrf(:,is_lic)-pctsrf(:,is_ter)) 143 138 ELSE ! SIC=pICE-LIC … … 233 228 234 229 !--- Variables creation 235 ierr=NF90_DEF_VAR(nid,"TEMPS",NF90_FORMAT, dims,id_tim)230 ierr=NF90_DEF_VAR(nid,"TEMPS",NF90_FORMAT,(/ntim/),id_tim) 236 231 ierr=NF90_DEF_VAR(nid,"FOCE", NF90_FORMAT,dims,id_FOCE) 237 232 ierr=NF90_DEF_VAR(nid,"FSIC", NF90_FORMAT,dims,id_FSIC) … … 257 252 258 253 !--- Variables saving 259 ierr=NF90_PUT_VAR(nid,id_tim,(/( DBLE(k),k=1,ndays)/))254 ierr=NF90_PUT_VAR(nid,id_tim,(/(REAL(k),k=1,ndays)/)) 260 255 ierr=NF90_PUT_VAR(nid,id_FOCE,pctsrf_t(:,is_oce,:),(/1,1/),(/klon,ndays/)) 261 256 ierr=NF90_PUT_VAR(nid,id_FSIC,pctsrf_t(:,is_sic,:),(/1,1/),(/klon,ndays/)) … … 284 279 !------------------------------------------------------------------------------- 285 280 ! 286 SUBROUTINE get_2Dfield(fnam, mode, ibar, ndays, champo, flag, mask )281 SUBROUTINE get_2Dfield(fnam, mode, ibar, ndays, champo, flag, mask, lCPL) 287 282 ! 288 283 !------------------------------------------------------------------------------- … … 312 307 INTEGER, INTENT(IN) :: ndays ! current year number of days 313 308 REAL, POINTER, DIMENSION(:,:) :: champo ! output field = f(t) 314 LOGICAL, OPTIONAL, INTENT(IN) :: flag 315 ! flag=T means: extrapolation (SST case) or old ice (SIC case) 309 LOGICAL, OPTIONAL, INTENT(IN) :: flag ! extrapol. (SST) old ice (SIC) 316 310 REAL, OPTIONAL, DIMENSION(iim,jjp1), INTENT(IN) :: mask 311 LOGICAL, OPTIONAL, INTENT(IN) :: lCPL ! Coupled model flag (for ICE) 317 312 !------------------------------------------------------------------------------- 318 313 ! Local variables: … … 397 392 timeyear=mid_months(anneeref,cal_in,lmdep) 398 393 IF(lmdep/=12) WRITE(lunout,'(a,i3,a)')'Note: les fichiers de '//TRIM(mode) & 399 //' ne comportent pas 12, mais ',lmdep,' renregistrements.'394 //' ne comportent pas 12, mais ',lmdep,' enregistrements.' 400 395 401 396 !--- GETTING THE FIELD AND INTERPOLATING IT ------------------------------------ … … 480 475 IF(mode=='SIC') THEN 481 476 WRITE(lunout,*) 'Filtrage de la SIC: 0.0 < Sea-ice < 1.0' 482 champan(:,:,:)=champan(:,:,:)/100.477 IF(.NOT.lCPL) champan(:,:,:)=champan(:,:,:)/100. 483 478 champan(iip1,:,:)=champan(1,:,:) 484 479 WHERE(champan>1.0) champan=1.0 … … 486 481 END IF 487 482 488 write(*,*)'coin1'489 483 !--- DYNAMICAL TO PHYSICAL GRID ------------------------------------------------ 490 484 ALLOCATE(champo(klon,ndays)) … … 492 486 CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k),champo(1,k)) 493 487 END DO 494 write(*,*)'coin2'495 488 DEALLOCATE(champan) 496 write(*,*)'coin3' 489 497 490 END SUBROUTINE get_2Dfield 498 491 ! -
LMDZ4/trunk/libf/dyn3dpar/etat0_netcdf.F90
r1323 r1328 214 214 WRITE(lunout,fmt)int(ocemask) 215 215 ocemask_fi(1)=ocemask(1,1) 216 DO j=2,jjm; ocemask_fi((j-2)*iim+ 1:iim+1)=ocemask(1:iim,j); END DO216 DO j=2,jjm; ocemask_fi((j-2)*iim+2:(j-1)*iim+1)=ocemask(1:iim,j); END DO 217 217 ocemask_fi(klon)=ocemask(1,jjp1) 218 218 zmasq=1.-ocemask_fi -
LMDZ4/trunk/libf/dyn3dpar/limit_netcdf.F90
r1323 r1328 81 81 INTEGER :: NF90_FORMAT 82 82 LOGICAL :: lCPL !--- T: IPCC-IPSL cpl model output files 83 84 !--- MICS (PHYSICAL KEYS, TIME) ------------------------------------------------ 85 ! INTEGER, PARAMETER :: longcles=20 86 ! REAL, DIMENSION(longcles) :: clesphy0 87 INTEGER :: ndays 88 83 INTEGER :: ndays !--- Depending on the output calendar 84 89 85 !--- INITIALIZATIONS ----------------------------------------------------------- 90 86 #ifdef NC_DOUBLE … … 94 90 #endif 95 91 96 ! CALL conf_gcm(99, .TRUE., clesphy0)97 92 pi = 4.*ATAN(1.) 98 93 rad = 6371229. … … 129 124 WRITE(lunout,*)'Pour la glace de mer a ete choisi un fichier '//TRIM(dumstr) 130 125 131 CALL get_2Dfield(icefile,'SIC',interbar,ndays,phy_ice,flag=oldice )126 CALL get_2Dfield(icefile,'SIC',interbar,ndays,phy_ice,flag=oldice,lCPL=lCPL) 132 127 133 128 ALLOCATE(pctsrf_t(klon,nbsrf,ndays)) … … 139 134 pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter) ! land soil 140 135 pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic) ! land ice 141 IF(lCPL) THEN ! SIC=pICE*(1-LIC-TER)136 IF(lCPL) THEN ! SIC=pICE*(1-LIC-TER) 142 137 pctsrf_t(:,is_sic,k)=fi_ice*(1-pctsrf(:,is_lic)-pctsrf(:,is_ter)) 143 138 ELSE ! SIC=pICE-LIC … … 233 228 234 229 !--- Variables creation 235 ierr=NF90_DEF_VAR(nid,"TEMPS",NF90_FORMAT, dims,id_tim)230 ierr=NF90_DEF_VAR(nid,"TEMPS",NF90_FORMAT,(/ntim/),id_tim) 236 231 ierr=NF90_DEF_VAR(nid,"FOCE", NF90_FORMAT,dims,id_FOCE) 237 232 ierr=NF90_DEF_VAR(nid,"FSIC", NF90_FORMAT,dims,id_FSIC) … … 257 252 258 253 !--- Variables saving 259 ierr=NF90_PUT_VAR(nid,id_tim,(/( DBLE(k),k=1,ndays)/))254 ierr=NF90_PUT_VAR(nid,id_tim,(/(REAL(k),k=1,ndays)/)) 260 255 ierr=NF90_PUT_VAR(nid,id_FOCE,pctsrf_t(:,is_oce,:),(/1,1/),(/klon,ndays/)) 261 256 ierr=NF90_PUT_VAR(nid,id_FSIC,pctsrf_t(:,is_sic,:),(/1,1/),(/klon,ndays/)) … … 284 279 !------------------------------------------------------------------------------- 285 280 ! 286 SUBROUTINE get_2Dfield(fnam, mode, ibar, ndays, champo, flag, mask )281 SUBROUTINE get_2Dfield(fnam, mode, ibar, ndays, champo, flag, mask, lCPL) 287 282 ! 288 283 !------------------------------------------------------------------------------- … … 312 307 INTEGER, INTENT(IN) :: ndays ! current year number of days 313 308 REAL, POINTER, DIMENSION(:,:) :: champo ! output field = f(t) 314 LOGICAL, OPTIONAL, INTENT(IN) :: flag 315 ! flag=T means: extrapolation (SST case) or old ice (SIC case) 309 LOGICAL, OPTIONAL, INTENT(IN) :: flag ! extrapol. (SST) old ice (SIC) 316 310 REAL, OPTIONAL, DIMENSION(iim,jjp1), INTENT(IN) :: mask 311 LOGICAL, OPTIONAL, INTENT(IN) :: lCPL ! Coupled model flag (for ICE) 317 312 !------------------------------------------------------------------------------- 318 313 ! Local variables: … … 397 392 timeyear=mid_months(anneeref,cal_in,lmdep) 398 393 IF(lmdep/=12) WRITE(lunout,'(a,i3,a)')'Note: les fichiers de '//TRIM(mode) & 399 //' ne comportent pas 12, mais ',lmdep,' renregistrements.'394 //' ne comportent pas 12, mais ',lmdep,' enregistrements.' 400 395 401 396 !--- GETTING THE FIELD AND INTERPOLATING IT ------------------------------------ … … 480 475 IF(mode=='SIC') THEN 481 476 WRITE(lunout,*) 'Filtrage de la SIC: 0.0 < Sea-ice < 1.0' 482 champan(:,:,:)=champan(:,:,:)/100.477 IF(.NOT.lCPL) champan(:,:,:)=champan(:,:,:)/100. 483 478 champan(iip1,:,:)=champan(1,:,:) 484 479 WHERE(champan>1.0) champan=1.0 … … 486 481 END IF 487 482 488 write(*,*)'coin1'489 483 !--- DYNAMICAL TO PHYSICAL GRID ------------------------------------------------ 490 484 ALLOCATE(champo(klon,ndays)) … … 492 486 CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k),champo(1,k)) 493 487 END DO 494 write(*,*)'coin2'495 488 DEALLOCATE(champan) 496 write(*,*)'coin3' 489 497 490 END SUBROUTINE get_2Dfield 498 491 !
Note: See TracChangeset
for help on using the changeset viewer.