Ignore:
Timestamp:
Oct 27, 2012, 4:23:07 PM (12 years ago)
Author:
Laurent Fairhead
Message:

Fin du phasage de la dynamique parallele localisee (petite memoire) avec le tronc LMDZ5 r1671
Il reste quelques routines a verifier (en particulier ce qui touche a l'etude des cas academiques)
et la validation a effectuer

End of the phasing of the localised (low memory) parallel dynamics package with the
LMDZ5 trunk (r1671)
Some routines still need some checking (in particular the academic cases) and some
validation is still required

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r1658 r1673  
    11!
    2 ! $Id: limit_netcdf.F90 1425 2010-09-02 13:45:23Z lguez $
     2! $Id$
    33!-------------------------------------------------------------------------------
    44!
    … …  
    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
    … …  
    9793  kappa = 0.2857143
    9894  cpp   = 1004.70885
    99   dtvr  = daysec/FLOAT(day_step)
     95  dtvr  = daysec/REAL(day_step)
    10096  CALL inigeom
    10197
    … …  
    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)
    267 #endif
    268 ! of #ifdef CPP_EARTH
    269252
    270253
    … …  
    278261!-------------------------------------------------------------------------------
    279262!
    280 SUBROUTINE get_2Dfield(fnam, mode, ibar, ndays, champo, flag, mask, lCPL)
     263SUBROUTINE get_2Dfield(fnam, varname, mode, ibar, ndays, champo, flag, mask)
    281264!
    282265!-----------------------------------------------------------------------------
    … …  
    306289! Arguments:
    307290  CHARACTER(LEN=*),  INTENT(IN)     :: fnam     ! NetCDF file name
     291  CHARACTER(LEN=10), INTENT(IN)     :: varname  ! NetCDF variable name
    308292  CHARACTER(LEN=3),  INTENT(IN)     :: mode     ! RUG, SIC, SST or ALB
    309293  LOGICAL,           INTENT(IN)     :: ibar     ! interp on pressure levels
    310294  INTEGER,           INTENT(IN)     :: ndays    ! current year number of days
    311   REAL,    POINTER,  DIMENSION(:, :) :: champo   ! output field = f(t)
     295  REAL,    POINTER,  DIMENSION(:, :) :: champo  ! output field = f(t)
    312296  LOGICAL, OPTIONAL, INTENT(IN)     :: flag     ! extrapol. (SST) old ice (SIC)
    313297  REAL,    OPTIONAL, DIMENSION(iim, jjp1), INTENT(IN) :: mask
    314   LOGICAL, OPTIONAL, INTENT(IN)     :: lCPL     ! Coupled model flag (for ICE)
    315298!------------------------------------------------------------------------------
    316299! Local variables:
    … …  
    318301  INTEGER :: ncid, varid                  ! NetCDF identifiers
    319302  CHARACTER(LEN=30)               :: dnam       ! dimension name
    320   CHARACTER(LEN=80)               :: varname    ! NetCDF variable name
    321303!--- dimensions
    322304  INTEGER,           DIMENSION(4) :: dids       ! NetCDF dimensions identifiers
    … …  
    333315!--- input files
    334316  CHARACTER(LEN=20)                 :: cal_in   ! calendar
     317  CHARACTER(LEN=20)                 :: unit_sic ! attribute unit in sea-ice file
    335318  INTEGER                           :: ndays_in ! number of days
    336319!--- misc
    … …  
    339322  CHARACTER(LEN=25)                 :: title    ! for messages
    340323  LOGICAL                           :: extrp    ! flag for extrapolation
     324  LOGICAL                           :: oldice   ! flag for old way ice computation
    341325  REAL                              :: chmin, chmax
    342326  INTEGER ierr
    343327  integer n_extrap ! number of extrapolated points
    344328  logical skip
     329
    345330!------------------------------------------------------------------------------
    346331!---Variables depending on keyword 'mode' -------------------------------------
    347332  NULLIFY(champo)
     333
    348334  SELECT CASE(mode)
    349     CASE('RUG'); varname='RUGOS'; title='Rugosite'
    350     CASE('SIC'); varname='sicbcs'; title='Sea-ice'
    351     CASE('SST'); varname='tosbcs'; title='SST'
    352     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'
    353339  END SELECT
     340 
     341
    354342  extrp=.FALSE.
     343  oldice=.FALSE.
    355344  IF ( PRESENT(flag) ) THEN
    356345    IF ( flag .AND. mode=='SST' ) extrp=.TRUE.
     346    IF ( flag .AND. mode=='SIC' ) oldice=.TRUE.
    357347  END IF
    358348
    359349!--- GETTING SOME DIMENSIONAL VARIABLES FROM FILE -----------------------------
     350  IF (prt_level>5) WRITE(lunout,*) ' Now reading file : ',fnam
    360351  ierr=NF90_OPEN(fnam, NF90_NOWRITE, ncid);             CALL ncerr(ierr, fnam)
    361   ierr=NF90_INQ_VARID(ncid, varname, varid);            CALL ncerr(ierr, fnam)
     352  ierr=NF90_INQ_VARID(ncid, trim(varname), varid);            CALL ncerr(ierr, fnam)
    362353  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
    363365
    364366!--- Longitude
    … …  
    367369  ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
    368370  ierr=NF90_GET_VAR(ncid, varid, dlon_ini);              CALL ncerr(ierr, fnam)
    369   WRITE(lunout, *) 'variable ', dnam, 'dimension ', imdep
     371  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', imdep
    370372
    371373!--- Latitude
    … …  
    374376  ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
    375377  ierr=NF90_GET_VAR(ncid, varid, dlat_ini);              CALL ncerr(ierr, fnam)
    376   WRITE(lunout, *) 'variable ', dnam, 'dimension ', jmdep
     378  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', jmdep
    377379
    378380!--- Time (variable is not needed - it is rebuilt - but calendar is)
    … …  
    387389      CASE('SIC', 'SST'); cal_in='gregorian'
    388390    END SELECT
    389     WRITE(lunout, *)'ATTENTION: variable "time" sans attribut "calendrier" ' &
     391    IF (prt_level>5) WRITE(lunout, *)'ATTENTION: variable "time" sans attribut "calendrier" ' &
    390392         // 'dans '//TRIM(fnam)//'. On choisit la valeur par defaut.'
    391393  END IF
    392   WRITE(lunout, *) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', &
     394  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', &
    393395       cal_in
    394396
     397 
    395398!--- CONSTRUCTING THE INPUT TIME VECTOR FOR INTERPOLATION --------------------
    396399  !--- Determining input file number of days, depending on calendar
    … …  
    400403!--- If input records are not monthly, time sampling has to be constant !
    401404  timeyear=mid_months(anneeref, cal_in, lmdep)
    402   IF (lmdep /= 12) WRITE(lunout, '(a, i3, a)') 'Note : les fichiers de ' &
    403        // TRIM(mode) // ' ne comportent pas 12, mais ', lmdep, &
    404        ' enregistrements.'
     405  IF (lmdep /= 12) WRITE(lunout,*) 'Note : les fichiers de ', TRIM(mode), &
     406       ' ne comportent pas 12, mais ', lmdep, ' enregistrements.'
    405407
    406408!--- GETTING THE FIELD AND INTERPOLATING IT ----------------------------------
    … …  
    408410  IF(extrp) ALLOCATE(work(imdep, jmdep))
    409411
    410   WRITE(lunout, *)
    411   WRITE(lunout, '(a, i3, a)')'LECTURE ET INTERPOLATION HORIZ. DE ', lmdep, &
    412        ' CHAMPS.'
     412  IF (prt_level>5) WRITE(lunout, *)
     413  IF (prt_level>5) WRITE(lunout,*)'LECTURE ET INTERPOLATION HORIZ. DE ', lmdep, ' CHAMPS.'
    413414  ierr=NF90_INQ_VARID(ncid, varname, varid);             CALL ncerr(ierr, fnam)
    414415  DO l=1, lmdep
    … …  
    421422         work)
    422423
    423     IF(ibar.AND..NOT.(mode=='SIC'.AND.flag)) THEN
    424       IF(l==1) THEN
    425         WRITE(lunout, *)                                                      &
    426   '-------------------------------------------------------------------------'
    427         WRITE(lunout, *)                                                     &
    428   'Utilisation de l''interpolation barycentrique pour '//TRIM(title)//' $$$'
    429         WRITE(lunout, *)                                                      &
    430   '-------------------------------------------------------------------------'
     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, *) '-------------------------------------------------------------------------'
    431429      END IF
    432430      IF(mode=='RUG') champ=LOG(champ)
    … …  
    455453
    456454!--- TIME INTERPOLATION ------------------------------------------------------
    457   WRITE(lunout, *)
    458   WRITE(lunout, *)'INTERPOLATION TEMPORELLE.'
    459   WRITE(lunout, "(2x, ' Vecteur temps en entree: ', 10f6.1)") timeyear
    460   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
    461462  ALLOCATE(yder(lmdep), champan(iip1, jjp1, ndays))
    462463  skip = .false.
    … …  
    473474  END DO
    474475  if (n_extrap /= 0) then
    475      print *, "get_2Dfield pchfe_95: n_extrap = ", n_extrap
     476     WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap
    476477  end if
    477478  champan(iip1, :, :)=champan(1, :, :)
    … …  
    481482  DO j=1, jjp1
    482483    CALL minmax(iip1, champan(1, j, 10), chmin, chmax)
    483     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
    484485  END DO
    485486
    486487!--- SPECIAL FILTER FOR SST: SST>271.38 --------------------------------------
    487488  IF(mode=='SST') THEN
    488     WRITE(lunout, *) 'Filtrage de la SST: SST >= 271.38'
     489    IF (prt_level>5) WRITE(lunout, *) 'Filtrage de la SST: SST >= 271.38'
    489490    WHERE(champan<271.38) champan=271.38
    490491  END IF
    … …  
    492493!--- SPECIAL FILTER FOR SIC: 0.0<SIC<1.0 -------------------------------------
    493494  IF(mode=='SIC') THEN
    494     WRITE(lunout, *) 'Filtrage de la SIC: 0.0 < Sea-ice < 1.0'
    495     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
    496507    champan(iip1, :, :)=champan(1, :, :)
    497508    WHERE(champan>1.0) champan=1.0
    498509    WHERE(champan<0.0) champan=0.0
    499   END IF
     510 END IF
    500511
    501512!--- DYNAMICAL TO PHYSICAL GRID ----------------------------------------------
    … …  
    592603
    593604!--- Mid-months times
    594   mid_months(1)=0.5*FLOAT(mnth(1))
     605  mid_months(1)=0.5*REAL(mnth(1))
    595606  DO k=2,nm
    596     mid_months(k)=mid_months(k-1)+0.5*FLOAT(mnth(k-1)+mnth(k))
     607    mid_months(k)=mid_months(k-1)+0.5*REAL(mnth(k-1)+mnth(k))
    597608  END DO
    598609
    … …  
    626637!-------------------------------------------------------------------------------
    627638
     639#endif
     640! of #ifdef CPP_EARTH
    628641
    629642END SUBROUTINE limit_netcdf
Note: See TracChangeset for help on using the changeset viewer.