Changeset 270 for trunk/LMDZ.COMMON/libf/dyn3d/limit_netcdf.F90
- Timestamp:
- Aug 18, 2011, 12:09:27 PM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.COMMON/libf/dyn3d/limit_netcdf.F90
r7 r270 1 1 ! 2 ! $Id: limit_netcdf.F90 1 441 2010-10-13 13:06:56Z emillour$2 ! $Id: limit_netcdf.F90 1508 2011-04-15 13:05:34Z jghattas $ 3 3 !------------------------------------------------------------------------------- 4 4 ! … … 42 42 REAL, DIMENSION(iip1,jjp1), INTENT(IN) :: masque ! land mask 43 43 #ifndef CPP_EARTH 44 WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'44 CALL abort_gcm('limit_netcdf','Earth-specific routine, needs Earth physics',1) 45 45 #else 46 46 !------------------------------------------------------------------------------- … … 52 52 #include "indicesol.h" 53 53 54 !--- For fractionary sub-cell use (old coding used soil index: 0,1,2,3) --------55 LOGICAL, PARAMETER :: fracterre=.TRUE.56 57 54 !--- INPUT NETCDF FILES NAMES -------------------------------------------------- 58 55 CHARACTER(LEN=25) :: icefile, sstfile, dumstr 59 56 CHARACTER(LEN=25), PARAMETER :: famipsst='amipbc_sst_1x1.nc ', & 60 57 famipsic='amipbc_sic_1x1.nc ', & 61 fclimsst='amipbc_sst_1x1_clim.nc ', &62 fclimsic='amipbc_sic_1x1_clim.nc ', &63 58 fcpldsst='cpl_atm_sst.nc ', & 64 59 fcpldsic='cpl_atm_sic.nc ', & 60 fhistsst='histmth_sst.nc ', & 61 fhistsic='histmth_sic.nc ', & 65 62 frugo ='Rugos.nc ', & 66 63 falbe ='Albedo.nc ' 67 64 CHARACTER(LEN=10) :: varname 68 65 !--- OUTPUT VARIABLES FOR NETCDF FILE ------------------------------------------ 69 66 REAL, DIMENSION(klon) :: fi_ice, verif … … 80 77 INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC 81 78 INTEGER :: NF90_FORMAT 82 LOGICAL :: lCPL !--- T: IPCC-IPSL cpl model output files83 79 INTEGER :: ndays !--- Depending on the output calendar 84 80 … … 104 100 105 101 !--- RUGOSITY TREATMENT -------------------------------------------------------- 106 WRITE(lunout,*) 'Traitement de la rugosite' 107 CALL get_2Dfield(frugo,'RUG',interbar,ndays,phy_rug,mask=masque(1:iim,:)) 102 IF (prt_level>1) WRITE(lunout,*) 'Traitement de la rugosite' 103 varname='RUGOS' 104 CALL get_2Dfield(frugo,varname,'RUG',interbar,ndays,phy_rug,mask=masque(1:iim,:)) 108 105 109 106 !--- OCEAN TREATMENT ----------------------------------------------------------- 110 PRINT*, 'Traitement de la glace oceanique' ; icefile=''; lCPL=.FALSE.107 IF (prt_level>1) WRITE(lunout,*) 'Traitement de la glace oceanique' 111 108 112 109 ! Input SIC file selection 113 icefile='fake' 114 IF(NF90_OPEN(famipsic,NF90_NOWRITE,nid)==NF90_NOERR) icefile=TRIM(famipsic) 115 IF(NF90_OPEN(fclimsic,NF90_NOWRITE,nid)==NF90_NOERR) icefile=TRIM(fclimsic) 116 IF(NF90_OPEN(fcpldsic,NF90_NOWRITE,nid)==NF90_NOERR) icefile=TRIM(fcpldsic) 117 SELECT CASE(icefile) 118 CASE(famipsic); dumstr='Amip.' 119 CASE(fclimsic); dumstr='Amip climatologique.' 120 CASE(fcpldsic); dumstr='de sortie du modele couplé IPSL/IPCC.';lCPL=.TRUE. 121 CASE('fake'); CALL abort_gcm('limit_netcdf','Fichier SIC non reconnu.',1) 122 END SELECT 110 ! Open file only to test if available 111 IF ( NF90_OPEN(TRIM(famipsic),NF90_NOWRITE,nid)==NF90_NOERR ) THEN 112 icefile=TRIM(famipsic) 113 varname='sicbcs' 114 ELSE IF( NF90_OPEN(TRIM(fcpldsic),NF90_NOWRITE,nid)==NF90_NOERR ) THEN 115 icefile=TRIM(fcpldsic) 116 varname='SIICECOV' 117 ELSE IF ( NF90_OPEN(TRIM(fhistsic),NF90_NOWRITE,nid)==NF90_NOERR ) THEN 118 icefile=TRIM(fhistsic) 119 varname='pourc_sic' 120 ELSE 121 WRITE(lunout,*) 'ERROR! No sea-ice input file was found.' 122 WRITE(lunout,*) 'One of following files must be availible : ',trim(famipsic),', ',trim(fcpldsic),', ',trim(fhistsic) 123 CALL abort_gcm('limit_netcdf','No sea-ice file was found',1) 124 END IF 123 125 ierr=NF90_CLOSE(nid) 124 WRITE(lunout,*)'Pour la glace de mer a ete choisi un fichier '//TRIM(dumstr)125 126 CALL get_2Dfield(icefile, 'SIC',interbar,ndays,phy_ice,flag=oldice,lCPL=lCPL)126 IF (prt_level>=0) WRITE(lunout,*)'Pour la glace de mer a ete choisi le fichier '//TRIM(icefile) 127 128 CALL get_2Dfield(icefile,varname, 'SIC',interbar,ndays,phy_ice,flag=oldice) 127 129 128 130 ALLOCATE(pctsrf_t(klon,nbsrf,ndays)) 129 131 DO k=1,ndays 130 fi_ice=phy_ice(:,k) 131 WHERE(fi_ice>=1.0 ) fi_ice=1.0 132 WHERE(fi_ice<EPSFRA) fi_ice=0.0 133 IF(fracterre) THEN 134 pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter) ! land soil 135 pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic) ! land ice 136 IF(lCPL) THEN ! SIC=pICE*(1-LIC-TER) 137 pctsrf_t(:,is_sic,k)=fi_ice*(1-pctsrf(:,is_lic)-pctsrf(:,is_ter)) 138 ELSE ! SIC=pICE-LIC 132 fi_ice=phy_ice(:,k) 133 WHERE(fi_ice>=1.0 ) fi_ice=1.0 134 WHERE(fi_ice<EPSFRA) fi_ice=0.0 135 pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter) ! land soil 136 pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic) ! land ice 137 IF (icefile==trim(fcpldsic)) THEN ! SIC=pICE*(1-LIC-TER) 138 pctsrf_t(:,is_sic,k)=fi_ice(:)*(1.-pctsrf(:,is_lic)-pctsrf(:,is_ter)) 139 ELSE IF (icefile==trim(fhistsic)) THEN ! SIC=pICE 140 pctsrf_t(:,is_sic,k)=fi_ice(:) 141 ELSE ! icefile==famipsic ! SIC=pICE-LIC 139 142 pctsrf_t(:,is_sic,k)=fi_ice-pctsrf_t(:,is_lic,k) 140 141 142 143 END IF 144 WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0. 145 WHERE(1.0-zmasq<EPSFRA) 143 146 pctsrf_t(:,is_sic,k)=0.0 144 147 pctsrf_t(:,is_oce,k)=0.0 145 148 ELSEWHERE 146 149 WHERE(pctsrf_t(:,is_sic,k)>=1.0-zmasq) 147 pctsrf_t(:,is_sic,k)=1.0-zmasq148 pctsrf_t(:,is_oce,k)=0.0150 pctsrf_t(:,is_sic,k)=1.0-zmasq 151 pctsrf_t(:,is_oce,k)=0.0 149 152 ELSEWHERE 150 pctsrf_t(:,is_oce,k)=1.0-zmasq-pctsrf_t(:,is_sic,k)151 WHERE(pctsrf_t(:,is_oce,k)<EPSFRA)152 pctsrf_t(:,is_oce,k)=0.0153 pctsrf_t(:,is_sic,k)=1.0-zmasq154 END WHERE153 pctsrf_t(:,is_oce,k)=1.0-zmasq-pctsrf_t(:,is_sic,k) 154 WHERE(pctsrf_t(:,is_oce,k)<EPSFRA) 155 pctsrf_t(:,is_oce,k)=0.0 156 pctsrf_t(:,is_sic,k)=1.0-zmasq 157 END WHERE 155 158 END WHERE 156 END WHERE 157 nbad=COUNT(pctsrf_t(:,is_oce,k)<0.0) 158 IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb point = ',nbad 159 nbad=COUNT(abs(sum(pctsrf_t(:,:,k),dim=2)-1.0)>EPSFRA) 160 IF(nbad>0) WRITE(lunout,*) 'pb sous surface pour nb points = ',nbad 161 ELSE 162 pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter) 163 WHERE(NINT(pctsrf(:,is_ter))==1) 164 pctsrf_t(:,is_sic,k)=0. 165 pctsrf_t(:,is_oce,k)=0. 166 WHERE(fi_ice>=1.e-5) 167 pctsrf_t(:,is_lic,k)=fi_ice 168 pctsrf_t(:,is_ter,k)=pctsrf_t(:,is_ter,k)-pctsrf_t(:,is_lic,k) 169 ELSEWHERE 170 pctsrf_t(:,is_lic,k)=0.0 171 END WHERE 172 ELSEWHERE 173 pctsrf_t(:,is_lic,k) = 0.0 174 WHERE(fi_ice>=1.e-5) 175 pctsrf_t(:,is_ter,k)=0.0 176 pctsrf_t(:,is_sic,k)=fi_ice 177 pctsrf_t(:,is_oce,k)=1.0-pctsrf_t(:,is_sic,k) 178 ELSEWHERE 179 pctsrf_t(:,is_sic,k)=0.0 180 pctsrf_t(:,is_oce,k)=1.0 181 END WHERE 182 END WHERE 183 verif=sum(pctsrf_t(:,:,k),dim=2) 184 nbad=COUNT(verif<1.0-1.e-5.OR.verif>1.0+1.e-5) 185 IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb point = ',nbad 186 END IF 159 END WHERE 160 nbad=COUNT(pctsrf_t(:,is_oce,k)<0.0) 161 IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb point = ',nbad 162 nbad=COUNT(abs(sum(pctsrf_t(:,:,k),dim=2)-1.0)>EPSFRA) 163 IF(nbad>0) WRITE(lunout,*) 'pb sous surface pour nb points = ',nbad 187 164 END DO 188 165 DEALLOCATE(phy_ice) 189 166 190 167 !--- SST TREATMENT ------------------------------------------------------------- 191 WRITE(lunout,*) 'Traitement de la sst' ; sstfile=''; lCPL=.FALSE.168 IF (prt_level>1) WRITE(lunout,*) 'Traitement de la sst' 192 169 193 170 ! Input SST file selection 194 sstfile='fake' 195 IF(NF90_OPEN(famipsst,NF90_NOWRITE,nid)==NF90_NOERR) sstfile=TRIM(famipsst) 196 IF(NF90_OPEN(fclimsst,NF90_NOWRITE,nid)==NF90_NOERR) sstfile=TRIM(fclimsst) 197 IF(NF90_OPEN(fcpldsst,NF90_NOWRITE,nid)==NF90_NOERR) sstfile=TRIM(fcpldsst) 198 SELECT CASE(icefile) 199 CASE(famipsic); dumstr='Amip.' 200 CASE(fclimsic); dumstr='Amip climatologique.' 201 CASE(fcpldsic); dumstr='de sortie du modele couplé IPSL/IPCC.';lCPL=.TRUE. 202 CASE('fake'); CALL abort_gcm('limit_netcdf','Fichier SST non reconnu',1) 203 END SELECT 171 ! Open file only to test if available 172 IF ( NF90_OPEN(TRIM(famipsst),NF90_NOWRITE,nid)==NF90_NOERR ) THEN 173 sstfile=TRIM(famipsst) 174 varname='tosbcs' 175 ELSE IF ( NF90_OPEN(TRIM(fcpldsst),NF90_NOWRITE,nid)==NF90_NOERR ) THEN 176 sstfile=TRIM(fcpldsst) 177 varname='SISUTESW' 178 ELSE IF ( NF90_OPEN(TRIM(fhistsst),NF90_NOWRITE,nid)==NF90_NOERR ) THEN 179 sstfile=TRIM(fhistsst) 180 varname='tsol_oce' 181 ELSE 182 WRITE(lunout,*) 'ERROR! No sst input file was found.' 183 WRITE(lunout,*) 'One of following files must be availible : ',trim(famipsst),trim(fcpldsst),trim(fhistsst) 184 CALL abort_gcm('limit_netcdf','No sst file was found',1) 185 END IF 204 186 ierr=NF90_CLOSE(nid) 205 WRITE(lunout,*)'Pour la temperature de mer a ete choisi un fichier '//TRIM(dumstr)206 207 CALL get_2Dfield( trim(sstfile),'SST',interbar,ndays,phy_sst,flag=extrap)187 IF (prt_level>=0) WRITE(lunout,*)'Pour la temperature de mer a ete choisi un fichier '//TRIM(sstfile) 188 189 CALL get_2Dfield(sstfile,varname,'SST',interbar,ndays,phy_sst,flag=extrap) 208 190 209 191 !--- ALBEDO TREATMENT ---------------------------------------------------------- 210 WRITE(lunout,*) 'Traitement de l albedo' 211 CALL get_2Dfield(falbe,'ALB',interbar,ndays,phy_alb) 192 IF (prt_level>1) WRITE(lunout,*) 'Traitement de l albedo' 193 varname='ALBEDO' 194 CALL get_2Dfield(falbe,varname,'ALB',interbar,ndays,phy_alb) 212 195 213 196 !--- REFERENCE GROUND HEAT FLUX TREATMENT -------------------------------------- … … 215 198 216 199 !--- OUTPUT FILE WRITING ------------------------------------------------------- 217 WRITE(lunout,*) 'Ecriture du fichier limit'200 IF (prt_level>5) WRITE(lunout,*) 'Ecriture du fichier limit : debut' 218 201 219 202 !--- File creation … … 264 247 ierr=NF90_CLOSE(nid) 265 248 249 IF (prt_level>5) WRITE(lunout,*) 'Ecriture du fichier limit : fin' 250 266 251 DEALLOCATE(pctsrf_t,phy_sst,phy_bil,phy_alb,phy_rug) 267 252 … … 276 261 !------------------------------------------------------------------------------- 277 262 ! 278 SUBROUTINE get_2Dfield(fnam, mode, ibar, ndays, champo, flag, mask, lCPL)263 SUBROUTINE get_2Dfield(fnam, varname, mode, ibar, ndays, champo, flag, mask) 279 264 ! 280 265 !----------------------------------------------------------------------------- … … 304 289 ! Arguments: 305 290 CHARACTER(LEN=*), INTENT(IN) :: fnam ! NetCDF file name 291 CHARACTER(LEN=10), INTENT(IN) :: varname ! NetCDF variable name 306 292 CHARACTER(LEN=3), INTENT(IN) :: mode ! RUG, SIC, SST or ALB 307 293 LOGICAL, INTENT(IN) :: ibar ! interp on pressure levels 308 294 INTEGER, INTENT(IN) :: ndays ! current year number of days 309 REAL, POINTER, DIMENSION(:, :) :: champo 295 REAL, POINTER, DIMENSION(:, :) :: champo ! output field = f(t) 310 296 LOGICAL, OPTIONAL, INTENT(IN) :: flag ! extrapol. (SST) old ice (SIC) 311 297 REAL, OPTIONAL, DIMENSION(iim, jjp1), INTENT(IN) :: mask 312 LOGICAL, OPTIONAL, INTENT(IN) :: lCPL ! Coupled model flag (for ICE)313 298 !------------------------------------------------------------------------------ 314 299 ! Local variables: … … 316 301 INTEGER :: ncid, varid ! NetCDF identifiers 317 302 CHARACTER(LEN=30) :: dnam ! dimension name 318 CHARACTER(LEN=80) :: varname ! NetCDF variable name319 303 !--- dimensions 320 304 INTEGER, DIMENSION(4) :: dids ! NetCDF dimensions identifiers … … 331 315 !--- input files 332 316 CHARACTER(LEN=20) :: cal_in ! calendar 317 CHARACTER(LEN=20) :: unit_sic ! attribute unit in sea-ice file 333 318 INTEGER :: ndays_in ! number of days 334 319 !--- misc … … 337 322 CHARACTER(LEN=25) :: title ! for messages 338 323 LOGICAL :: extrp ! flag for extrapolation 324 LOGICAL :: oldice ! flag for old way ice computation 339 325 REAL :: chmin, chmax 340 326 INTEGER ierr 341 327 integer n_extrap ! number of extrapolated points 342 328 logical skip 329 343 330 !------------------------------------------------------------------------------ 344 331 !---Variables depending on keyword 'mode' ------------------------------------- 345 332 NULLIFY(champo) 333 346 334 SELECT CASE(mode) 347 CASE('RUG'); varname='RUGOS';title='Rugosite'348 CASE('SIC'); varname='sicbcs'; title='Sea-ice'349 CASE('SST'); varname='tosbcs'; title='SST'350 CASE('ALB'); varname='ALBEDO'; title='Albedo'335 CASE('RUG'); title='Rugosite' 336 CASE('SIC'); title='Sea-ice' 337 CASE('SST'); title='SST' 338 CASE('ALB'); title='Albedo' 351 339 END SELECT 340 341 352 342 extrp=.FALSE. 343 oldice=.FALSE. 353 344 IF ( PRESENT(flag) ) THEN 354 345 IF ( flag .AND. mode=='SST' ) extrp=.TRUE. 346 IF ( flag .AND. mode=='SIC' ) oldice=.TRUE. 355 347 END IF 356 348 357 349 !--- GETTING SOME DIMENSIONAL VARIABLES FROM FILE ----------------------------- 350 IF (prt_level>5) WRITE(lunout,*) ' Now reading file : ',fnam 358 351 ierr=NF90_OPEN(fnam, NF90_NOWRITE, ncid); CALL ncerr(ierr, fnam) 359 ierr=NF90_INQ_VARID(ncid, varname, varid); CALL ncerr(ierr, fnam)352 ierr=NF90_INQ_VARID(ncid, trim(varname), varid); CALL ncerr(ierr, fnam) 360 353 ierr=NF90_INQUIRE_VARIABLE(ncid, varid, dimids=dids); CALL ncerr(ierr, fnam) 354 355 !--- Read unit for sea-ice variable only 356 IF (mode=='SIC') THEN 357 ierr=NF90_GET_ATT(ncid, varid, 'units', unit_sic) 358 IF(ierr/=NF90_NOERR) THEN 359 IF (prt_level>5) WRITE(lunout,*) 'No unit was given in sea-ice file. Take percentage as default value' 360 unit_sic='X' 361 ELSE 362 IF (prt_level>5) WRITE(lunout,*) ' Sea-ice cover has unit=',unit_sic 363 END IF 364 END IF 361 365 362 366 !--- Longitude … … 365 369 ierr=NF90_INQ_VARID(ncid, dnam, varid); CALL ncerr(ierr, fnam) 366 370 ierr=NF90_GET_VAR(ncid, varid, dlon_ini); CALL ncerr(ierr, fnam) 367 WRITE(lunout, *) 'variable ', dnam, 'dimension ', imdep371 IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', imdep 368 372 369 373 !--- Latitude … … 372 376 ierr=NF90_INQ_VARID(ncid, dnam, varid); CALL ncerr(ierr, fnam) 373 377 ierr=NF90_GET_VAR(ncid, varid, dlat_ini); CALL ncerr(ierr, fnam) 374 WRITE(lunout, *) 'variable ', dnam, 'dimension ', jmdep378 IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', jmdep 375 379 376 380 !--- Time (variable is not needed - it is rebuilt - but calendar is) … … 385 389 CASE('SIC', 'SST'); cal_in='gregorian' 386 390 END SELECT 387 WRITE(lunout, *)'ATTENTION: variable "time" sans attribut "calendrier" ' &391 IF (prt_level>5) WRITE(lunout, *)'ATTENTION: variable "time" sans attribut "calendrier" ' & 388 392 // 'dans '//TRIM(fnam)//'. On choisit la valeur par defaut.' 389 393 END IF 390 WRITE(lunout, *) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', &394 IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', & 391 395 cal_in 392 396 397 393 398 !--- CONSTRUCTING THE INPUT TIME VECTOR FOR INTERPOLATION -------------------- 394 399 !--- Determining input file number of days, depending on calendar … … 398 403 !--- If input records are not monthly, time sampling has to be constant ! 399 404 timeyear=mid_months(anneeref, cal_in, lmdep) 400 IF (lmdep /= 12) WRITE(lunout, '(a, i3, a)') 'Note : les fichiers de ' & 401 // TRIM(mode) // ' ne comportent pas 12, mais ', lmdep, & 402 ' enregistrements.' 405 IF (lmdep /= 12) WRITE(lunout,*) 'Note : les fichiers de ', TRIM(mode), & 406 ' ne comportent pas 12, mais ', lmdep, ' enregistrements.' 403 407 404 408 !--- GETTING THE FIELD AND INTERPOLATING IT ---------------------------------- … … 406 410 IF(extrp) ALLOCATE(work(imdep, jmdep)) 407 411 408 WRITE(lunout, *) 409 WRITE(lunout, '(a, i3, a)')'LECTURE ET INTERPOLATION HORIZ. DE ', lmdep, & 410 ' CHAMPS.' 412 IF (prt_level>5) WRITE(lunout, *) 413 IF (prt_level>5) WRITE(lunout,*)'LECTURE ET INTERPOLATION HORIZ. DE ', lmdep, ' CHAMPS.' 411 414 ierr=NF90_INQ_VARID(ncid, varname, varid); CALL ncerr(ierr, fnam) 412 415 DO l=1, lmdep … … 419 422 work) 420 423 421 IF(ibar.AND..NOT.(mode=='SIC'.AND.flag)) THEN 422 IF(l==1) THEN 423 WRITE(lunout, *) & 424 '-------------------------------------------------------------------------' 425 WRITE(lunout, *) & 426 'Utilisation de l''interpolation barycentrique pour '//TRIM(title)//' $$$' 427 WRITE(lunout, *) & 428 '-------------------------------------------------------------------------' 424 IF(ibar .AND. .NOT.oldice) THEN 425 IF(l==1 .AND. prt_level>5) THEN 426 WRITE(lunout, *) '-------------------------------------------------------------------------' 427 WRITE(lunout, *) 'Utilisation de l''interpolation barycentrique pour ',TRIM(title),' $$$' 428 WRITE(lunout, *) '-------------------------------------------------------------------------' 429 429 END IF 430 430 IF(mode=='RUG') champ=LOG(champ) … … 453 453 454 454 !--- TIME INTERPOLATION ------------------------------------------------------ 455 WRITE(lunout, *) 456 WRITE(lunout, *)'INTERPOLATION TEMPORELLE.' 457 WRITE(lunout, "(2x, ' Vecteur temps en entree: ', 10f6.1)") timeyear 458 WRITE(lunout, "(2x, ' Vecteur temps en sortie de 0 a ', i3)") ndays 455 IF (prt_level>5) THEN 456 WRITE(lunout, *) 457 WRITE(lunout, *)'INTERPOLATION TEMPORELLE.' 458 WRITE(lunout, *)' Vecteur temps en entree: ', timeyear 459 WRITE(lunout, *)' Vecteur temps en sortie de 0 a ', ndays 460 END IF 461 459 462 ALLOCATE(yder(lmdep), champan(iip1, jjp1, ndays)) 460 463 skip = .false. … … 471 474 END DO 472 475 if (n_extrap /= 0) then 473 print *,"get_2Dfield pchfe_95: n_extrap = ", n_extrap476 WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap 474 477 end if 475 478 champan(iip1, :, :)=champan(1, :, :) … … 479 482 DO j=1, jjp1 480 483 CALL minmax(iip1, champan(1, j, 10), chmin, chmax) 481 WRITE(lunout, *)' '//TRIM(title)//' au temps 10 ', chmin, chmax, j484 IF (prt_level>5) WRITE(lunout, *)' ',TRIM(title),' au temps 10 ', chmin, chmax, j 482 485 END DO 483 486 484 487 !--- SPECIAL FILTER FOR SST: SST>271.38 -------------------------------------- 485 488 IF(mode=='SST') THEN 486 WRITE(lunout, *) 'Filtrage de la SST: SST >= 271.38'489 IF (prt_level>5) WRITE(lunout, *) 'Filtrage de la SST: SST >= 271.38' 487 490 WHERE(champan<271.38) champan=271.38 488 491 END IF … … 490 493 !--- SPECIAL FILTER FOR SIC: 0.0<SIC<1.0 ------------------------------------- 491 494 IF(mode=='SIC') THEN 492 WRITE(lunout, *) 'Filtrage de la SIC: 0.0 < Sea-ice < 1.0' 493 IF(.NOT.lCPL) champan(:, :, :)=champan(:, :, :)/100. 495 IF (prt_level>5) WRITE(lunout, *) 'Filtrage de la SIC: 0.0 < Sea-ice < 1.0' 496 497 IF (unit_sic=='1') THEN 498 ! Nothing to be done for sea-ice field is already in fraction of 1 499 ! This is the case for sea-ice in file cpl_atm_sic.nc 500 IF (prt_level>5) WRITE(lunout,*) 'Sea-ice field already in fraction of 1' 501 ELSE 502 ! Convert sea ice from percentage to fraction of 1 503 IF (prt_level>5) WRITE(lunout,*) 'Transformt sea-ice field from percentage to fraction of 1.' 504 champan(:, :, :)=champan(:, :, :)/100. 505 END IF 506 494 507 champan(iip1, :, :)=champan(1, :, :) 495 508 WHERE(champan>1.0) champan=1.0 496 509 WHERE(champan<0.0) champan=0.0 497 510 END IF 498 511 499 512 !--- DYNAMICAL TO PHYSICAL GRID ----------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.