Changeset 1508


Ignore:
Timestamp:
Apr 15, 2011, 3:05:34 PM (13 years ago)
Author:
jghattas
Message:
  • Add specific treatement for file histmth_sst.nc and histmth_sic.nc : these files have the same format as histmth.nc files written during a previous LMDZ run. The files contains 12 monthly values of SST and sea-ice cover.
  • Remove specific treatement for file amipbc_sst_1x1_clim.nc and amipbc_sic_1x1_clim.nc : use option amipbc_sst_1x1.nc and amipbc_sic_1x1.nc.
  • Removed logical fracterre and the part where fracterre=F. The code doesn't change behavior.
  • All text output are under control prt_level.
Location:
LMDZ5/trunk/libf
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/dyn3d/limit_netcdf.F90

    r1454 r1508  
    4242  REAL, DIMENSION(iip1,jjp1), INTENT(IN) :: masque   ! land mask
    4343#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)
    4545#else
    4646!-------------------------------------------------------------------------------
    … …  
    5252#include "indicesol.h"
    5353
    54 !--- For fractionary sub-cell use (old coding used soil index: 0,1,2,3) --------
    55   LOGICAL, PARAMETER :: fracterre=.TRUE.
    56 
    5754!--- INPUT NETCDF FILES NAMES --------------------------------------------------
    5855  CHARACTER(LEN=25) :: icefile, sstfile, dumstr
    5956  CHARACTER(LEN=25), PARAMETER :: famipsst='amipbc_sst_1x1.nc        ',        &
    6057                                  famipsic='amipbc_sic_1x1.nc        ',        &
    61                                   fclimsst='amipbc_sst_1x1_clim.nc   ',        &
    62                                   fclimsic='amipbc_sic_1x1_clim.nc   ',        &
    6358                                  fcpldsst='cpl_atm_sst.nc           ',        &
    6459                                  fcpldsic='cpl_atm_sic.nc           ',        &
     60                                  fhistsst='histmth_sst.nc           ',        &
     61                                  fhistsic='histmth_sic.nc           ',        &
    6562                                  frugo   ='Rugos.nc                 ',        &
    6663                                  falbe   ='Albedo.nc                '
    67 
     64  CHARACTER(LEN=10) :: varname
    6865!--- OUTPUT VARIABLES FOR NETCDF FILE ------------------------------------------
    6966  REAL,   DIMENSION(klon)                :: fi_ice, verif
    … …  
    8077  INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC
    8178  INTEGER :: NF90_FORMAT
    82   LOGICAL :: lCPL                    !--- T: IPCC-IPSL cpl model output files
    8379  INTEGER :: ndays                   !--- Depending on the output calendar
    8480
    … …  
    104100
    105101!--- 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,:))
    108105
    109106!--- OCEAN TREATMENT -----------------------------------------------------------
    110   PRINT*, 'Traitement de la glace oceanique' ; icefile=''; lCPL=.FALSE.
     107  IF (prt_level>1) WRITE(lunout,*) 'Traitement de la glace oceanique'
    111108
    112109! 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
    123125  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)
    127129
    128130  ALLOCATE(pctsrf_t(klon,nbsrf,ndays))
    129131  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
    139142        pctsrf_t(:,is_sic,k)=fi_ice-pctsrf_t(:,is_lic,k)
    140       END IF
    141       WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0.
    142       WHERE(1.0-zmasq<EPSFRA)
     143     END IF
     144     WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0.
     145     WHERE(1.0-zmasq<EPSFRA)
    143146        pctsrf_t(:,is_sic,k)=0.0
    144147        pctsrf_t(:,is_oce,k)=0.0
    145       ELSEWHERE
     148     ELSEWHERE
    146149        WHERE(pctsrf_t(:,is_sic,k)>=1.0-zmasq)
    147           pctsrf_t(:,is_sic,k)=1.0-zmasq
    148           pctsrf_t(:,is_oce,k)=0.0
     150           pctsrf_t(:,is_sic,k)=1.0-zmasq
     151           pctsrf_t(:,is_oce,k)=0.0
    149152        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.0
    153             pctsrf_t(:,is_sic,k)=1.0-zmasq
    154           END WHERE
     153           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
    155158        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
    187164  END DO
    188165  DEALLOCATE(phy_ice)
    189166
    190167!--- SST TREATMENT -------------------------------------------------------------
    191   WRITE(lunout,*) 'Traitement de la sst' ; sstfile=''; lCPL=.FALSE.
     168  IF (prt_level>1) WRITE(lunout,*) 'Traitement de la sst'
    192169
    193170! 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
    204186  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)
    208190
    209191!--- 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)
    212195
    213196!--- REFERENCE GROUND HEAT FLUX TREATMENT --------------------------------------
    … …  
    215198
    216199!--- OUTPUT FILE WRITING -------------------------------------------------------
    217   WRITE(lunout,*) 'Ecriture du fichier limit'
     200  IF (prt_level>5) WRITE(lunout,*) 'Ecriture du fichier limit : debut'
    218201
    219202  !--- File creation
    … …  
    264247  ierr=NF90_CLOSE(nid)
    265248
     249  IF (prt_level>5) WRITE(lunout,*) 'Ecriture du fichier limit : fin'
     250
    266251  DEALLOCATE(pctsrf_t,phy_sst,phy_bil,phy_alb,phy_rug)
    267252
    … …  
    276261!-------------------------------------------------------------------------------
    277262!
    278 SUBROUTINE get_2Dfield(fnam, mode, ibar, ndays, champo, flag, mask, lCPL)
     263SUBROUTINE get_2Dfield(fnam, varname, mode, ibar, ndays, champo, flag, mask)
    279264!
    280265!-----------------------------------------------------------------------------
    … …  
    304289! Arguments:
    305290  CHARACTER(LEN=*),  INTENT(IN)     :: fnam     ! NetCDF file name
     291  CHARACTER(LEN=10), INTENT(IN)     :: varname  ! NetCDF variable name
    306292  CHARACTER(LEN=3),  INTENT(IN)     :: mode     ! RUG, SIC, SST or ALB
    307293  LOGICAL,           INTENT(IN)     :: ibar     ! interp on pressure levels
    308294  INTEGER,           INTENT(IN)     :: ndays    ! current year number of days
    309   REAL,    POINTER,  DIMENSION(:, :) :: champo   ! output field = f(t)
     295  REAL,    POINTER,  DIMENSION(:, :) :: champo  ! output field = f(t)
    310296  LOGICAL, OPTIONAL, INTENT(IN)     :: flag     ! extrapol. (SST) old ice (SIC)
    311297  REAL,    OPTIONAL, DIMENSION(iim, jjp1), INTENT(IN) :: mask
    312   LOGICAL, OPTIONAL, INTENT(IN)     :: lCPL     ! Coupled model flag (for ICE)
    313298!------------------------------------------------------------------------------
    314299! Local variables:
    … …  
    316301  INTEGER :: ncid, varid                  ! NetCDF identifiers
    317302  CHARACTER(LEN=30)               :: dnam       ! dimension name
    318   CHARACTER(LEN=80)               :: varname    ! NetCDF variable name
    319303!--- dimensions
    320304  INTEGER,           DIMENSION(4) :: dids       ! NetCDF dimensions identifiers
    … …  
    331315!--- input files
    332316  CHARACTER(LEN=20)                 :: cal_in   ! calendar
     317  CHARACTER(LEN=20)                 :: unit_sic ! attribute unit in sea-ice file
    333318  INTEGER                           :: ndays_in ! number of days
    334319!--- misc
    … …  
    337322  CHARACTER(LEN=25)                 :: title    ! for messages
    338323  LOGICAL                           :: extrp    ! flag for extrapolation
     324  LOGICAL                           :: oldice   ! flag for old way ice computation
    339325  REAL                              :: chmin, chmax
    340326  INTEGER ierr
    341327  integer n_extrap ! number of extrapolated points
    342328  logical skip
     329
    343330!------------------------------------------------------------------------------
    344331!---Variables depending on keyword 'mode' -------------------------------------
    345332  NULLIFY(champo)
     333
    346334  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'
    351339  END SELECT
     340 
     341
    352342  extrp=.FALSE.
     343  oldice=.FALSE.
    353344  IF ( PRESENT(flag) ) THEN
    354345    IF ( flag .AND. mode=='SST' ) extrp=.TRUE.
     346    IF ( flag .AND. mode=='SIC' ) oldice=.TRUE.
    355347  END IF
    356348
    357349!--- GETTING SOME DIMENSIONAL VARIABLES FROM FILE -----------------------------
     350  IF (prt_level>5) WRITE(lunout,*) ' Now reading file : ',fnam
    358351  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)
    360353  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
    361365
    362366!--- Longitude
    … …  
    365369  ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
    366370  ierr=NF90_GET_VAR(ncid, varid, dlon_ini);              CALL ncerr(ierr, fnam)
    367   WRITE(lunout, *) 'variable ', dnam, 'dimension ', imdep
     371  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', imdep
    368372
    369373!--- Latitude
    … …  
    372376  ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
    373377  ierr=NF90_GET_VAR(ncid, varid, dlat_ini);              CALL ncerr(ierr, fnam)
    374   WRITE(lunout, *) 'variable ', dnam, 'dimension ', jmdep
     378  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', jmdep
    375379
    376380!--- Time (variable is not needed - it is rebuilt - but calendar is)
    … …  
    385389      CASE('SIC', 'SST'); cal_in='gregorian'
    386390    END SELECT
    387     WRITE(lunout, *)'ATTENTION: variable "time" sans attribut "calendrier" ' &
     391    IF (prt_level>5) WRITE(lunout, *)'ATTENTION: variable "time" sans attribut "calendrier" ' &
    388392         // 'dans '//TRIM(fnam)//'. On choisit la valeur par defaut.'
    389393  END IF
    390   WRITE(lunout, *) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', &
     394  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', &
    391395       cal_in
    392396
     397 
    393398!--- CONSTRUCTING THE INPUT TIME VECTOR FOR INTERPOLATION --------------------
    394399  !--- Determining input file number of days, depending on calendar
    … …  
    398403!--- If input records are not monthly, time sampling has to be constant !
    399404  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.'
    403407
    404408!--- GETTING THE FIELD AND INTERPOLATING IT ----------------------------------
    … …  
    406410  IF(extrp) ALLOCATE(work(imdep, jmdep))
    407411
    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.'
    411414  ierr=NF90_INQ_VARID(ncid, varname, varid);             CALL ncerr(ierr, fnam)
    412415  DO l=1, lmdep
    … …  
    419422         work)
    420423
    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, *) '-------------------------------------------------------------------------'
    429429      END IF
    430430      IF(mode=='RUG') champ=LOG(champ)
    … …  
    453453
    454454!--- 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
    459462  ALLOCATE(yder(lmdep), champan(iip1, jjp1, ndays))
    460463  skip = .false.
    … …  
    471474  END DO
    472475  if (n_extrap /= 0) then
    473      print *, "get_2Dfield pchfe_95: n_extrap = ", n_extrap
     476     WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap
    474477  end if
    475478  champan(iip1, :, :)=champan(1, :, :)
    … …  
    479482  DO j=1, jjp1
    480483    CALL minmax(iip1, champan(1, j, 10), chmin, chmax)
    481     WRITE(lunout, *)' '//TRIM(title)//' au temps 10 ', chmin, chmax, j
     484    IF (prt_level>5) WRITE(lunout, *)' ',TRIM(title),' au temps 10 ', chmin, chmax, j
    482485  END DO
    483486
    484487!--- SPECIAL FILTER FOR SST: SST>271.38 --------------------------------------
    485488  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'
    487490    WHERE(champan<271.38) champan=271.38
    488491  END IF
    … …  
    490493!--- SPECIAL FILTER FOR SIC: 0.0<SIC<1.0 -------------------------------------
    491494  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
    494507    champan(iip1, :, :)=champan(1, :, :)
    495508    WHERE(champan>1.0) champan=1.0
    496509    WHERE(champan<0.0) champan=0.0
    497   END IF
     510 END IF
    498511
    499512!--- DYNAMICAL TO PHYSICAL GRID ----------------------------------------------

  • LMDZ5/trunk/libf/dyn3dpar/limit_netcdf.F90

    r1454 r1508  
    4242  REAL, DIMENSION(iip1,jjp1), INTENT(IN) :: masque   ! land mask
    4343#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)
    4545#else
    4646!-------------------------------------------------------------------------------
    … …  
    5252#include "indicesol.h"
    5353
    54 !--- For fractionary sub-cell use (old coding used soil index: 0,1,2,3) --------
    55   LOGICAL, PARAMETER :: fracterre=.TRUE.
    56 
    5754!--- INPUT NETCDF FILES NAMES --------------------------------------------------
    5855  CHARACTER(LEN=25) :: icefile, sstfile, dumstr
    5956  CHARACTER(LEN=25), PARAMETER :: famipsst='amipbc_sst_1x1.nc        ',        &
    6057                                  famipsic='amipbc_sic_1x1.nc        ',        &
    61                                   fclimsst='amipbc_sst_1x1_clim.nc   ',        &
    62                                   fclimsic='amipbc_sic_1x1_clim.nc   ',        &
    6358                                  fcpldsst='cpl_atm_sst.nc           ',        &
    6459                                  fcpldsic='cpl_atm_sic.nc           ',        &
     60                                  fhistsst='histmth_sst.nc           ',        &
     61                                  fhistsic='histmth_sic.nc           ',        &
    6562                                  frugo   ='Rugos.nc                 ',        &
    6663                                  falbe   ='Albedo.nc                '
    67 
     64  CHARACTER(LEN=10) :: varname
    6865!--- OUTPUT VARIABLES FOR NETCDF FILE ------------------------------------------
    6966  REAL,   DIMENSION(klon)                :: fi_ice, verif
    … …  
    8077  INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC
    8178  INTEGER :: NF90_FORMAT
    82   LOGICAL :: lCPL                    !--- T: IPCC-IPSL cpl model output files
    8379  INTEGER :: ndays                   !--- Depending on the output calendar
    8480
    … …  
    104100
    105101!--- 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,:))
    108105
    109106!--- OCEAN TREATMENT -----------------------------------------------------------
    110   PRINT*, 'Traitement de la glace oceanique' ; icefile=''; lCPL=.FALSE.
     107  IF (prt_level>1) WRITE(lunout,*) 'Traitement de la glace oceanique'
    111108
    112109! 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
    123125  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)
    127129
    128130  ALLOCATE(pctsrf_t(klon,nbsrf,ndays))
    129131  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
    139142        pctsrf_t(:,is_sic,k)=fi_ice-pctsrf_t(:,is_lic,k)
    140       END IF
    141       WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0.
    142       WHERE(1.0-zmasq<EPSFRA)
     143     END IF
     144     WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0.
     145     WHERE(1.0-zmasq<EPSFRA)
    143146        pctsrf_t(:,is_sic,k)=0.0
    144147        pctsrf_t(:,is_oce,k)=0.0
    145       ELSEWHERE
     148     ELSEWHERE
    146149        WHERE(pctsrf_t(:,is_sic,k)>=1.0-zmasq)
    147           pctsrf_t(:,is_sic,k)=1.0-zmasq
    148           pctsrf_t(:,is_oce,k)=0.0
     150           pctsrf_t(:,is_sic,k)=1.0-zmasq
     151           pctsrf_t(:,is_oce,k)=0.0
    149152        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.0
    153             pctsrf_t(:,is_sic,k)=1.0-zmasq
    154           END WHERE
     153           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
    155158        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
    187164  END DO
    188165  DEALLOCATE(phy_ice)
    189166
    190167!--- SST TREATMENT -------------------------------------------------------------
    191   WRITE(lunout,*) 'Traitement de la sst' ; sstfile=''; lCPL=.FALSE.
     168  IF (prt_level>1) WRITE(lunout,*) 'Traitement de la sst'
    192169
    193170! 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
    204186  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)
    208190
    209191!--- 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)
    212195
    213196!--- REFERENCE GROUND HEAT FLUX TREATMENT --------------------------------------
    … …  
    215198
    216199!--- OUTPUT FILE WRITING -------------------------------------------------------
    217   WRITE(lunout,*) 'Ecriture du fichier limit'
     200  IF (prt_level>5) WRITE(lunout,*) 'Ecriture du fichier limit : debut'
    218201
    219202  !--- File creation
    … …  
    264247  ierr=NF90_CLOSE(nid)
    265248
     249  IF (prt_level>5) WRITE(lunout,*) 'Ecriture du fichier limit : fin'
     250
    266251  DEALLOCATE(pctsrf_t,phy_sst,phy_bil,phy_alb,phy_rug)
    267252
    … …  
    276261!-------------------------------------------------------------------------------
    277262!
    278 SUBROUTINE get_2Dfield(fnam, mode, ibar, ndays, champo, flag, mask, lCPL)
     263SUBROUTINE get_2Dfield(fnam, varname, mode, ibar, ndays, champo, flag, mask)
    279264!
    280265!-----------------------------------------------------------------------------
    … …  
    304289! Arguments:
    305290  CHARACTER(LEN=*),  INTENT(IN)     :: fnam     ! NetCDF file name
     291  CHARACTER(LEN=10), INTENT(IN)     :: varname  ! NetCDF variable name
    306292  CHARACTER(LEN=3),  INTENT(IN)     :: mode     ! RUG, SIC, SST or ALB
    307293  LOGICAL,           INTENT(IN)     :: ibar     ! interp on pressure levels
    308294  INTEGER,           INTENT(IN)     :: ndays    ! current year number of days
    309   REAL,    POINTER,  DIMENSION(:, :) :: champo   ! output field = f(t)
     295  REAL,    POINTER,  DIMENSION(:, :) :: champo  ! output field = f(t)
    310296  LOGICAL, OPTIONAL, INTENT(IN)     :: flag     ! extrapol. (SST) old ice (SIC)
    311297  REAL,    OPTIONAL, DIMENSION(iim, jjp1), INTENT(IN) :: mask
    312   LOGICAL, OPTIONAL, INTENT(IN)     :: lCPL     ! Coupled model flag (for ICE)
    313298!------------------------------------------------------------------------------
    314299! Local variables:
    … …  
    316301  INTEGER :: ncid, varid                  ! NetCDF identifiers
    317302  CHARACTER(LEN=30)               :: dnam       ! dimension name
    318   CHARACTER(LEN=80)               :: varname    ! NetCDF variable name
    319303!--- dimensions
    320304  INTEGER,           DIMENSION(4) :: dids       ! NetCDF dimensions identifiers
    … …  
    331315!--- input files
    332316  CHARACTER(LEN=20)                 :: cal_in   ! calendar
     317  CHARACTER(LEN=20)                 :: unit_sic ! attribute unit in sea-ice file
    333318  INTEGER                           :: ndays_in ! number of days
    334319!--- misc
    … …  
    337322  CHARACTER(LEN=25)                 :: title    ! for messages
    338323  LOGICAL                           :: extrp    ! flag for extrapolation
     324  LOGICAL                           :: oldice   ! flag for old way ice computation
    339325  REAL                              :: chmin, chmax
    340326  INTEGER ierr
    341327  integer n_extrap ! number of extrapolated points
    342328  logical skip
     329
    343330!------------------------------------------------------------------------------
    344331!---Variables depending on keyword 'mode' -------------------------------------
    345332  NULLIFY(champo)
     333
    346334  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'
    351339  END SELECT
     340 
     341
    352342  extrp=.FALSE.
     343  oldice=.FALSE.
    353344  IF ( PRESENT(flag) ) THEN
    354345    IF ( flag .AND. mode=='SST' ) extrp=.TRUE.
     346    IF ( flag .AND. mode=='SIC' ) oldice=.TRUE.
    355347  END IF
    356348
    357349!--- GETTING SOME DIMENSIONAL VARIABLES FROM FILE -----------------------------
     350  IF (prt_level>5) WRITE(lunout,*) ' Now reading file : ',fnam
    358351  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)
    360353  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
    361365
    362366!--- Longitude
    … …  
    365369  ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
    366370  ierr=NF90_GET_VAR(ncid, varid, dlon_ini);              CALL ncerr(ierr, fnam)
    367   WRITE(lunout, *) 'variable ', dnam, 'dimension ', imdep
     371  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', imdep
    368372
    369373!--- Latitude
    … …  
    372376  ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
    373377  ierr=NF90_GET_VAR(ncid, varid, dlat_ini);              CALL ncerr(ierr, fnam)
    374   WRITE(lunout, *) 'variable ', dnam, 'dimension ', jmdep
     378  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', jmdep
    375379
    376380!--- Time (variable is not needed - it is rebuilt - but calendar is)
    … …  
    385389      CASE('SIC', 'SST'); cal_in='gregorian'
    386390    END SELECT
    387     WRITE(lunout, *)'ATTENTION: variable "time" sans attribut "calendrier" ' &
     391    IF (prt_level>5) WRITE(lunout, *)'ATTENTION: variable "time" sans attribut "calendrier" ' &
    388392         // 'dans '//TRIM(fnam)//'. On choisit la valeur par defaut.'
    389393  END IF
    390   WRITE(lunout, *) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', &
     394  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', &
    391395       cal_in
    392396
     397 
    393398!--- CONSTRUCTING THE INPUT TIME VECTOR FOR INTERPOLATION --------------------
    394399  !--- Determining input file number of days, depending on calendar
    … …  
    398403!--- If input records are not monthly, time sampling has to be constant !
    399404  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.'
    403407
    404408!--- GETTING THE FIELD AND INTERPOLATING IT ----------------------------------
    … …  
    406410  IF(extrp) ALLOCATE(work(imdep, jmdep))
    407411
    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.'
    411414  ierr=NF90_INQ_VARID(ncid, varname, varid);             CALL ncerr(ierr, fnam)
    412415  DO l=1, lmdep
    … …  
    419422         work)
    420423
    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, *) '-------------------------------------------------------------------------'
    429429      END IF
    430430      IF(mode=='RUG') champ=LOG(champ)
    … …  
    453453
    454454!--- 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
    459462  ALLOCATE(yder(lmdep), champan(iip1, jjp1, ndays))
    460463  skip = .false.
    … …  
    471474  END DO
    472475  if (n_extrap /= 0) then
    473      print *, "get_2Dfield pchfe_95: n_extrap = ", n_extrap
     476     WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap
    474477  end if
    475478  champan(iip1, :, :)=champan(1, :, :)
    … …  
    479482  DO j=1, jjp1
    480483    CALL minmax(iip1, champan(1, j, 10), chmin, chmax)
    481     WRITE(lunout, *)' '//TRIM(title)//' au temps 10 ', chmin, chmax, j
     484    IF (prt_level>5) WRITE(lunout, *)' ',TRIM(title),' au temps 10 ', chmin, chmax, j
    482485  END DO
    483486
    484487!--- SPECIAL FILTER FOR SST: SST>271.38 --------------------------------------
    485488  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'
    487490    WHERE(champan<271.38) champan=271.38
    488491  END IF
    … …  
    490493!--- SPECIAL FILTER FOR SIC: 0.0<SIC<1.0 -------------------------------------
    491494  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
    494507    champan(iip1, :, :)=champan(1, :, :)
    495508    WHERE(champan>1.0) champan=1.0
    496509    WHERE(champan<0.0) champan=0.0
    497   END IF
     510 END IF
    498511
    499512!--- DYNAMICAL TO PHYSICAL GRID ----------------------------------------------
Note: See TracChangeset for help on using the changeset viewer.