source: LMDZ5/branches/IPSLCM6.0.10/libf/dynphy_lonlat/phylmd/limit_netcdf.F90 @ 3406

Last change on this file since 3406 was 2787, checked in by Laurent Fairhead, 8 years ago

Merged trunk changes r2727:2785 into testing branch

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 31.2 KB
Line 
1MODULE limit
2!
3!*******************************************************************************
4! Author : L. Fairhead, 27/01/94
5!-------------------------------------------------------------------------------
6! Purpose: Boundary conditions files building for new model using climatologies.
7!          Both grids have to be regular.
8!-------------------------------------------------------------------------------
9! Note: This routine is designed to work for Earth
10!-------------------------------------------------------------------------------
11! Modification history:
12!  * 23/03/1994: Z. X. Li
13!  *    09/1999: L. Fairhead (netcdf reading in LMDZ.3.3)
14!  *    07/2001: P. Le Van
15!  *    11/2009: L. Guez     (ozone day & night climatos, see etat0_netcdf.F90)
16!  *    12/2009: D. Cugnet   (f77->f90, calendars, files from coupled runs)
17!-------------------------------------------------------------------------------
18
19  USE ioipsl,             ONLY: flininfo, flinopen, flinget, flinclo
20  USE assert_eq_m,        ONLY: assert_eq
21  USE cal_tools_m,        ONLY: year_len, mid_month
22  USE conf_dat_m,         ONLY: conf_dat2d, conf_dat3d
23  USE dimphy,             ONLY: klon, zmasq
24  USE geometry_mod,       ONLY: longitude_deg, latitude_deg
25  USE phys_state_var_mod, ONLY: pctsrf
26  USE control_mod,        ONLY: anneeref
27  USE init_ssrf_m,        ONLY: start_init_subsurf
28
29  CHARACTER(LEN=20), PARAMETER :: &
30  fsst(4)=['amipbc_sst_1x1.nc   ','cpl_atm_sst.nc      ','histmth_sst.nc      '&
31          ,'sstk.nc             ']
32  CHARACTER(LEN=20), PARAMETER :: &
33  fsic(4)=['amipbc_sic_1x1.nc   ','cpl_atm_sic.nc      ','histmth_sic.nc      '&
34          ,'ci.nc               ']
35  CHARACTER(LEN=10), PARAMETER :: &
36  vsst(4)=['tosbcs    ','SISUTESW  ','tsol_oce  ','sstk      '], &
37  vsic(4)=['sicbcs    ','SIICECOV  ','pourc_sic ','ci        ']
38  CHARACTER(LEN=10), PARAMETER :: &
39  frugo='Rugos.nc  ', falbe='Albedo.nc ', frelf='Relief.nc ',    &
40   vrug='RUGOS     ',  valb='ALBEDO    ',  vrel='RELIEF    '
41
42CONTAINS
43
44!-------------------------------------------------------------------------------
45!
46SUBROUTINE limit_netcdf(masque, phis, extrap)
47!
48!-------------------------------------------------------------------------------
49! Author : L. Fairhead, 27/01/94
50!-------------------------------------------------------------------------------
51! Purpose: Boundary conditions files building for new model using climatologies.
52!          Both grids have to be regular.
53!-------------------------------------------------------------------------------
54! Note: This routine is designed to work for Earth
55!-------------------------------------------------------------------------------
56! Modification history:
57!  * 23/03/1994: Z. X. Li
58!  *    09/1999: L. Fairhead (netcdf reading in LMDZ.3.3)
59!  *    07/2001: P. Le Van
60!  *    11/2009: L. Guez     (ozone day & night climatos, see etat0_netcdf.F90)
61!  *    12/2009: D. Cugnet   (f77->f90, calendars, files from coupled runs)
62!  *    04/2016: D. Cugnet   (12/14 recs SST/SIC files: cyclic/interannual runs)
63!-------------------------------------------------------------------------------
64#ifndef CPP_1D
65  USE indice_sol_mod
66  USE netcdf,             ONLY: NF90_OPEN,    NF90_CREATE,  NF90_CLOSE,        &
67                  NF90_DEF_DIM, NF90_DEF_VAR, NF90_PUT_VAR, NF90_PUT_ATT,      &
68                  NF90_NOERR,   NF90_NOWRITE, NF90_DOUBLE,  NF90_GLOBAL,       &
69                  NF90_CLOBBER, NF90_ENDDEF,  NF90_UNLIMITED, NF90_FLOAT
70  USE inter_barxy_m,      ONLY: inter_barxy
71  USE netcdf95,           ONLY: nf95_def_var, nf95_put_att, nf95_put_var
72  USE comconst_mod, ONLY: pi
73  USE phys_cal_mod, ONLY: calend
74  IMPLICIT NONE
75!-------------------------------------------------------------------------------
76! Arguments:
77  include "iniprint.h"
78  include "dimensions.h"
79  include "paramet.h"
80  REAL, DIMENSION(iip1,jjp1), INTENT(INOUT) :: masque ! land mask
81  REAL, DIMENSION(iip1,jjp1), INTENT(INOUT) :: phis   ! ground geopotential
82  LOGICAL,                    INTENT(IN)    :: extrap ! SST extrapolation flag
83!-------------------------------------------------------------------------------
84! Local variables:
85  include "comgeom2.h"
86
87!--- INPUT NETCDF FILES NAMES --------------------------------------------------
88  CHARACTER(LEN=20) :: icefile, sstfile, dumstr, fnam
89  CHARACTER(LEN=10) :: varname
90
91!--- OUTPUT VARIABLES FOR NETCDF FILE ------------------------------------------
92  REAL               :: fi_ice(klon), verif(klon)
93  REAL, POINTER      :: phy_rug(:,:)=>NULL(), phy_ice(:,:)=>NULL()
94  REAL, POINTER      :: phy_sst(:,:)=>NULL(), phy_alb(:,:)=>NULL()
95  REAL, ALLOCATABLE  :: phy_bil(:,:), pctsrf_t(:,:,:)
96  INTEGER            :: nbad
97
98!--- VARIABLES FOR OUTPUT FILE WRITING -----------------------------------------
99  INTEGER :: ierr, nid, ndim, ntim, k, dims(2), ix_sic, ix_sst
100  INTEGER :: id_tim,  id_SST,  id_BILS, id_RUG, id_ALB
101  INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC, varid_longitude, varid_latitude
102  INTEGER :: NF90_FORMAT
103  INTEGER :: ndays                   !--- Depending on the output calendar
104
105!--- INITIALIZATIONS -----------------------------------------------------------
106#ifdef NC_DOUBLE
107  NF90_FORMAT=NF90_DOUBLE
108#else
109  NF90_FORMAT=NF90_FLOAT
110#endif
111  CALL inigeom
112
113!--- MASK, GROUND GEOPOT. & SUBSURFACES COMPUTATION (IN CASE ok_etat0==.FALSE.)
114   IF(ALL(masque==-99999.)) THEN
115    CALL start_init_orog0(rlonv,rlatu,phis,masque)
116    CALL gr_dyn_fi(1,iip1,jjp1,klon,masque,zmasq)          !--- To physical grid
117    ALLOCATE(pctsrf(klon,nbsrf))
118    CALL start_init_subsurf(.FALSE.)
119  !--- TO MATCH EXACTLY WHAT WOULD BE DONE IN etat0phys_netcdf
120    WHERE(   masque(:,:)<EPSFRA) masque(:,:)=0.
121    WHERE(1.-masque(:,:)<EPSFRA) masque(:,:)=1.
122  END IF
123
124!--- Beware: anneeref (from gcm.def) is used to determine output time sampling
125  ndays=year_len(anneeref)
126
127!--- RUGOSITY TREATMENT --------------------------------------------------------
128  CALL msg(1,'Traitement de la rugosite')
129  CALL get_2Dfield(frugo,vrug,'RUG',ndays,phy_rug,mask=masque(1:iim,:))
130
131!--- OCEAN TREATMENT -----------------------------------------------------------
132  CALL msg(1,'Traitement de la glace oceanique')
133
134! Input SIC file selection
135! Open file only to test if available
136  DO ix_sic=1,SIZE(fsic)
137     IF ( NF90_OPEN(TRIM(fsic(ix_sic)),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
138        icefile=fsic(ix_sic); varname=vsic(ix_sic); EXIT
139     END IF
140  END DO
141  IF(ix_sic==SIZE(fsic)+1) THEN
142     WRITE(lunout,*) 'ERROR! No sea-ice input file was found.'
143     WRITE(lunout,*) 'One of following files must be available : '
144     DO k=1,SIZE(fsic); WRITE(lunout,*) TRIM(fsic(k)); END DO
145     CALL abort_physic('limit_netcdf','No sea-ice file was found',1)
146  END IF
147  CALL ncerr(NF90_CLOSE(nid),icefile)
148  CALL msg(-1,'Fichier choisi pour la glace de mer:'//TRIM(icefile))
149
150  CALL get_2Dfield(icefile,varname, 'SIC',ndays,phy_ice)
151
152  ALLOCATE(pctsrf_t(klon,nbsrf,ndays))
153  DO k=1,ndays
154     fi_ice=phy_ice(:,k)
155     WHERE(fi_ice>=1.0  ) fi_ice=1.0
156     WHERE(fi_ice<EPSFRA) fi_ice=0.0
157     pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter)       ! land soil
158     pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic)       ! land ice
159     SELECT CASE(ix_sic)
160        CASE(2)                                   ! SIC=pICE*(1-LIC-TER) (CPL)
161        pctsrf_t(:,is_sic,k)=fi_ice(:)*(1.-pctsrf(:,is_lic)-pctsrf(:,is_ter))
162        CASE(3)                                   ! SIC=pICE            (HIST)
163        pctsrf_t(:,is_sic,k)=fi_ice(:)
164        CASE DEFAULT                              ! SIC=pICE-LIC   (AMIP,ERAI)
165        pctsrf_t(:,is_sic,k)=fi_ice-pctsrf_t(:,is_lic,k)
166     END SELECT
167     WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0.
168     WHERE(1.0-zmasq<EPSFRA)
169        pctsrf_t(:,is_sic,k)=0.0
170        pctsrf_t(:,is_oce,k)=0.0
171     ELSEWHERE
172        WHERE(pctsrf_t(:,is_sic,k)>=1.0-zmasq)
173           pctsrf_t(:,is_sic,k)=1.0-zmasq
174           pctsrf_t(:,is_oce,k)=0.0
175        ELSEWHERE
176           pctsrf_t(:,is_oce,k)=1.0-zmasq-pctsrf_t(:,is_sic,k)
177           WHERE(pctsrf_t(:,is_oce,k)<EPSFRA)
178              pctsrf_t(:,is_oce,k)=0.0
179              pctsrf_t(:,is_sic,k)=1.0-zmasq
180           END WHERE
181        END WHERE
182     END WHERE
183     nbad=COUNT(pctsrf_t(:,is_oce,k)<0.0)
184     IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb points = ',nbad
185     nbad=COUNT(ABS(SUM(pctsrf_t(:,:,k),DIM=2)-1.0)>EPSFRA)
186     IF(nbad>0) WRITE(lunout,*) 'pb sous surface pour nb points = ',nbad
187  END DO
188  DEALLOCATE(phy_ice)
189
190!--- SST TREATMENT -------------------------------------------------------------
191  CALL msg(1,'Traitement de la sst')
192
193! Input SST file selection
194! Open file only to test if available
195  DO ix_sst=1,SIZE(fsst)
196     IF ( NF90_OPEN(TRIM(fsst(ix_sst)),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
197       sstfile=fsst(ix_sst); varname=vsst(ix_sst); EXIT
198     END IF
199  END DO
200  IF(ix_sst==SIZE(fsst)+1) THEN
201     WRITE(lunout,*) 'ERROR! No sst input file was found.'
202     WRITE(lunout,*) 'One of following files must be available : '
203     DO k=1,SIZE(fsst); WRITE(lunout,*) TRIM(fsst(k)); END DO
204     CALL abort_physic('limit_netcdf','No sst file was found',1)
205  END IF
206  CALL ncerr(NF90_CLOSE(nid),sstfile)
207  CALL msg(-1,'Fichier choisi pour la temperature de mer: '//TRIM(sstfile))
208
209  CALL get_2Dfield(sstfile,varname,'SST',ndays,phy_sst,flag=extrap)
210
211!--- ALBEDO TREATMENT ----------------------------------------------------------
212  CALL msg(1,'Traitement de l albedo')
213  CALL get_2Dfield(falbe,valb,'ALB',ndays,phy_alb)
214
215!--- REFERENCE GROUND HEAT FLUX TREATMENT --------------------------------------
216  ALLOCATE(phy_bil(klon,ndays)); phy_bil=0.0
217
218!--- OUTPUT FILE WRITING -------------------------------------------------------
219  CALL msg(5,'Ecriture du fichier limit : debut')
220  fnam="limit.nc"
221
222  !--- File creation
223  CALL ncerr(NF90_CREATE(fnam,NF90_CLOBBER,nid),fnam)
224  CALL ncerr(NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier conditions aux limites"),fnam)
225
226  !--- Dimensions creation
227  CALL ncerr(NF90_DEF_DIM(nid,"points_physiques",klon,ndim),fnam)
228  CALL ncerr(NF90_DEF_DIM(nid,"time",NF90_UNLIMITED,ntim),fnam)
229
230  dims=[ndim,ntim]
231
232  !--- Variables creation
233  CALL ncerr(NF90_DEF_VAR(nid,"TEMPS",NF90_FORMAT,[ntim],id_tim),fnam)
234  CALL ncerr(NF90_DEF_VAR(nid,"FOCE", NF90_FORMAT,dims,id_FOCE),fnam)
235  CALL ncerr(NF90_DEF_VAR(nid,"FSIC", NF90_FORMAT,dims,id_FSIC),fnam)
236  CALL ncerr(NF90_DEF_VAR(nid,"FTER", NF90_FORMAT,dims,id_FTER),fnam)
237  CALL ncerr(NF90_DEF_VAR(nid,"FLIC", NF90_FORMAT,dims,id_FLIC),fnam)
238  CALL ncerr(NF90_DEF_VAR(nid,"SST",  NF90_FORMAT,dims,id_SST),fnam)
239  CALL ncerr(NF90_DEF_VAR(nid,"BILS", NF90_FORMAT,dims,id_BILS),fnam)
240  CALL ncerr(NF90_DEF_VAR(nid,"ALB",  NF90_FORMAT,dims,id_ALB),fnam)
241  CALL ncerr(NF90_DEF_VAR(nid,"RUG",  NF90_FORMAT,dims,id_RUG),fnam)
242  call nf95_def_var(nid, "longitude", NF90_FLOAT, ndim, varid_longitude)
243  call nf95_def_var(nid, "latitude",  NF90_FLOAT, ndim, varid_latitude)
244
245  !--- Attributes creation
246  CALL ncerr(NF90_PUT_ATT(nid,id_tim, "title","Jour dans l annee"),fnam)
247  CALL ncerr(NF90_PUT_ATT(nid,id_tim, "calendar",calend),fnam)
248  CALL ncerr(NF90_PUT_ATT(nid,id_FOCE,"title","Fraction ocean"),fnam)
249  CALL ncerr(NF90_PUT_ATT(nid,id_FSIC,"title","Fraction glace de mer"),fnam)
250  CALL ncerr(NF90_PUT_ATT(nid,id_FTER,"title","Fraction terre"),fnam)
251  CALL ncerr(NF90_PUT_ATT(nid,id_FLIC,"title","Fraction land ice"),fnam)
252  CALL ncerr(NF90_PUT_ATT(nid,id_SST ,"title","Temperature superficielle de la mer"),fnam)
253  CALL ncerr(NF90_PUT_ATT(nid,id_BILS,"title","Reference flux de chaleur au sol"),fnam)
254  CALL ncerr(NF90_PUT_ATT(nid,id_ALB, "title","Albedo a la surface"),fnam)
255  CALL ncerr(NF90_PUT_ATT(nid,id_RUG, "title","Rugosite"),fnam)
256
257  call nf95_put_att(nid, varid_longitude, "standard_name", "longitude")
258  call nf95_put_att(nid, varid_longitude, "units", "degrees_east")
259
260  call nf95_put_att(nid, varid_latitude, "standard_name", "latitude")
261  call nf95_put_att(nid, varid_latitude, "units", "degrees_north")
262
263  CALL ncerr(NF90_ENDDEF(nid),fnam)
264
265  !--- Variables saving
266  CALL ncerr(NF90_PUT_VAR(nid,id_tim,[(REAL(k),k=1,ndays)]),fnam)
267  CALL ncerr(NF90_PUT_VAR(nid,id_FOCE,pctsrf_t(:,is_oce,:),[1,1],[klon,ndays]),fnam)
268  CALL ncerr(NF90_PUT_VAR(nid,id_FSIC,pctsrf_t(:,is_sic,:),[1,1],[klon,ndays]),fnam)
269  CALL ncerr(NF90_PUT_VAR(nid,id_FTER,pctsrf_t(:,is_ter,:),[1,1],[klon,ndays]),fnam)
270  CALL ncerr(NF90_PUT_VAR(nid,id_FLIC,pctsrf_t(:,is_lic,:),[1,1],[klon,ndays]),fnam)
271  CALL ncerr(NF90_PUT_VAR(nid,id_SST ,phy_sst(:,:),[1,1],[klon,ndays]),fnam)
272  CALL ncerr(NF90_PUT_VAR(nid,id_BILS,phy_bil(:,:),[1,1],[klon,ndays]),fnam)
273  CALL ncerr(NF90_PUT_VAR(nid,id_ALB ,phy_alb(:,:),[1,1],[klon,ndays]),fnam)
274  CALL ncerr(NF90_PUT_VAR(nid,id_RUG ,phy_rug(:,:),[1,1],[klon,ndays]),fnam)
275  call nf95_put_var(nid, varid_longitude, longitude_deg)
276  call nf95_put_var(nid, varid_latitude, latitude_deg)
277
278  CALL ncerr(NF90_CLOSE(nid),fnam)
279
280  CALL msg(6,'Ecriture du fichier limit : fin')
281
282  DEALLOCATE(pctsrf_t,phy_sst,phy_bil,phy_alb,phy_rug)
283
284
285!===============================================================================
286!
287  CONTAINS
288!
289!===============================================================================
290
291
292!-------------------------------------------------------------------------------
293!
294SUBROUTINE get_2Dfield(fnam, varname, mode, ndays, champo, flag, mask)
295!
296!-----------------------------------------------------------------------------
297! Comments:
298!   There are two assumptions concerning the NetCDF files, that are satisfied
299!   with files that are conforming NC convention:
300!     1) The last dimension of the variables used is the time record.
301!     2) Dimensional variables have the same names as corresponding dimensions.
302!-----------------------------------------------------------------------------
303  USE netcdf, ONLY: NF90_OPEN, NF90_INQ_VARID, NF90_INQUIRE_VARIABLE, &
304       NF90_CLOSE, NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION, NF90_GET_VAR, &
305       NF90_GET_ATT
306  USE pchsp_95_m, only: pchsp_95
307  USE pchfe_95_m, only: pchfe_95
308  USE arth_m, only: arth
309  USE indice_sol_mod
310
311  IMPLICIT NONE
312  include "dimensions.h"
313  include "paramet.h"
314  include "comgeom2.h"
315!-----------------------------------------------------------------------------
316! Arguments:
317  CHARACTER(LEN=*),  INTENT(IN)     :: fnam     ! NetCDF file name
318  CHARACTER(LEN=10), INTENT(IN)     :: varname  ! NetCDF variable name
319  CHARACTER(LEN=3),  INTENT(IN)     :: mode     ! RUG, SIC, SST or ALB
320  INTEGER,           INTENT(IN)     :: ndays    ! current year number of days
321  REAL,    POINTER,  DIMENSION(:, :) :: champo  ! output field = f(t)
322  LOGICAL, OPTIONAL, INTENT(IN)     :: flag     ! extrapol. (SST) old ice (SIC)
323  REAL,    OPTIONAL, DIMENSION(iim, jjp1), INTENT(IN) :: mask
324!------------------------------------------------------------------------------
325! Local variables:
326!--- NetCDF
327  INTEGER           :: ncid, varid        ! NetCDF identifiers
328  CHARACTER(LEN=30) :: dnam               ! dimension name
329!--- dimensions
330  INTEGER           :: dids(4)            ! NetCDF dimensions identifiers
331  REAL, ALLOCATABLE :: dlon_ini(:)        ! initial longitudes vector
332  REAL, ALLOCATABLE :: dlat_ini(:)        ! initial latitudes  vector
333  REAL, POINTER     :: dlon(:), dlat(:)   ! reordered lon/lat  vectors
334!--- fields
335  INTEGER :: imdep, jmdep, lmdep          ! dimensions of 'champ'
336  REAL, ALLOCATABLE :: champ(:,:)         ! wanted field on initial grid
337  REAL, ALLOCATABLE :: yder(:), timeyear(:)
338  REAL              :: champint(iim,jjp1) ! interpolated field
339  REAL, ALLOCATABLE :: champtime(:,:,:)
340  REAL, ALLOCATABLE :: champan(:,:,:)
341!--- input files
342  CHARACTER(LEN=20) :: fnam_m, fnam_p     ! previous/next files names
343  CHARACTER(LEN=20) :: cal_in             ! calendar
344  CHARACTER(LEN=20) :: unit_sic           ! attribute unit in sea-ice file
345  INTEGER           :: ndays_in           ! number of days
346!--- misc
347  INTEGER           :: i, j, k, l, ll     ! loop counters
348  REAL, ALLOCATABLE :: work(:,:)          ! used for extrapolation
349  CHARACTER(LEN=128):: title, mess        ! for messages
350  LOGICAL           :: extrp              ! flag for extrapolation
351  REAL              :: chmin, chmax
352  INTEGER ierr, idx
353  integer n_extrap ! number of extrapolated points
354  logical skip
355
356!------------------------------------------------------------------------------
357!---Variables depending on keyword 'mode' -------------------------------------
358  NULLIFY(champo)
359
360  SELECT CASE(mode)
361  CASE('RUG'); title='Rugosite'
362  CASE('SIC'); title='Sea-ice'
363  CASE('SST'); title='SST'
364  CASE('ALB'); title='Albedo'
365  END SELECT
366  extrp=.FALSE.; IF(PRESENT(flag).AND.mode=='SST') extrp=flag
367  idx=INDEX(fnam,'.nc')-1
368
369!--- GETTING SOME DIMENSIONAL VARIABLES FROM FILE -----------------------------
370  CALL msg(5,' Now reading file : '//TRIM(fnam))
371  CALL ncerr(NF90_OPEN(fnam, NF90_NOWRITE, ncid),fnam)
372  CALL ncerr(NF90_INQ_VARID(ncid, trim(varname), varid),fnam)
373  CALL ncerr(NF90_INQUIRE_VARIABLE(ncid, varid, dimids=dids),fnam)
374
375!--- Read unit for sea-ice variable only
376  IF (mode=='SIC') THEN
377    ierr=NF90_GET_ATT(ncid, varid, 'units', unit_sic); CALL strclean(unit_sic)
378    IF(ierr/=NF90_NOERR) THEN
379      CALL msg(5,'No unit in sea-ice file. Take percentage as default value')
380      unit_sic='X'
381    ELSE IF(ANY(["%  ","1.0","1  "]==unit_sic)) THEN
382      CALL msg(5,'Sea-ice cover has unit='//TRIM(unit_sic))
383    ELSE
384      CALL abort_physic('SIC','Unrecognized unit for sea-ice file: '&
385        //TRIM(unit_sic),1)
386    END IF
387  END IF
388
389!--- Longitude
390  CALL ncerr(NF90_INQUIRE_DIMENSION(ncid, dids(1), name=dnam, len=imdep),fnam)
391  ALLOCATE(dlon_ini(imdep), dlon(imdep))
392  CALL ncerr(NF90_INQ_VARID(ncid, dnam, varid), fnam)
393  CALL ncerr(NF90_GET_VAR(ncid, varid, dlon_ini), fnam)
394  CALL msg(5,'variable '//TRIM(dnam)//' dimension ', imdep)
395
396!--- Latitude
397  CALL ncerr(NF90_INQUIRE_DIMENSION(ncid, dids(2), name=dnam, len=jmdep),fnam)
398  ALLOCATE(dlat_ini(jmdep), dlat(jmdep))
399  CALL ncerr(NF90_INQ_VARID(ncid, dnam, varid), fnam)
400  CALL ncerr(NF90_GET_VAR(ncid, varid, dlat_ini), fnam)
401  CALL msg(5,'variable '//TRIM(dnam)//' dimension ', jmdep)
402
403!--- Time (variable is not needed - it is rebuilt - but calendar is)
404  CALL ncerr(NF90_INQUIRE_DIMENSION(ncid, dids(3), name=dnam, len=lmdep), fnam)
405  ALLOCATE(timeyear(lmdep+2))
406  CALL ncerr(NF90_INQ_VARID(ncid, dnam, varid), fnam)
407  cal_in=' '
408  IF(NF90_GET_ATT(ncid, varid, 'calendar', cal_in)/=NF90_NOERR) THEN
409    SELECT CASE(mode)
410      CASE('RUG', 'ALB'); cal_in='360d'
411      CASE('SIC', 'SST'); cal_in='gregorian'
412    END SELECT
413    CALL msg(5,'WARNING: missing "calendar" attribute for "time" in '&
414     &//TRIM(fnam)//'. Choosing default value.')
415  END IF
416  CALL strclean(cal_in)                     !--- REMOVE (WEIRD) NULL CHARACTERS
417  CALL msg(5,'var, calendar, dim: '//TRIM(dnam)//' '//TRIM(cal_in), lmdep)
418 
419!--- Determining input file number of days, depending on calendar
420  ndays_in=year_len(anneeref, cal_in)
421
422!--- Rebuilding input time vector (field from input file might be unreliable)
423  IF(lmdep==12) THEN
424    timeyear=mid_month(anneeref, cal_in)
425    CALL msg(0,'Monthly input file(s) for '//TRIM(title)//'.')
426  ELSE IF(lmdep==ndays_in) THEN
427    timeyear=[(REAL(k)-0.5,k=0,ndays_in+1)]
428    CALL msg(0,'Daily input file (no time interpolation).')
429  ELSE
430    WRITE(mess,'(a,i3,a,i3,a)')'Mismatching input file: found',lmdep,        &
431      ' records, 12/',ndays_in,' (monthly/daily needed).'
432    CALL abort_physic('mid_month',TRIM(mess),1)
433  END IF
434
435!--- GETTING THE FIELD AND INTERPOLATING IT ----------------------------------
436  ALLOCATE(champ(imdep, jmdep), champtime(iim, jjp1, lmdep+2))
437  IF(extrp) ALLOCATE(work(imdep, jmdep))
438  CALL msg(5,'')
439  CALL msg(5,'READ AND INTERPOLATE HORIZONTALLY ', lmdep, ' FIELDS.')
440  CALL ncerr(NF90_INQ_VARID(ncid, varname, varid), fnam)
441  DO l=1, lmdep
442    CALL ncerr(NF90_GET_VAR(ncid,varid,champ,[1,1,l],[imdep,jmdep,1]),fnam)
443    !--- Check whether values are acceptable for SIC, depending on unit.
444    IF(mode=='SIC') THEN
445      IF(TRIM(unit_sic)=="1".OR.TRIM(unit_sic)=="1.0") THEN
446        IF(ANY(champ>1.0+EPSFRA)) &
447          CALL abort_physic('SIC','Found sea-ice fractions greater than 1.')
448      ELSE IF(TRIM(unit_sic)=="X".OR.TRIM(unit_sic)=="%") THEN
449!        IF(ANY(champ>100.0+EPSFRA)) &
450!          CALL abort_physic('SIC','Found sea-ice percentages greater than 100.')
451        IF(MAXVAL(champ)< 1.01) &
452          CALL abort_physic('SIC','All sea-ice percentages lower than 1.')
453      END IF
454    END IF
455    CALL conf_dat2d(title, dlon_ini, dlat_ini, dlon, dlat, champ, .TRUE.)
456    IF(extrp) CALL extrapol(champ,imdep,jmdep,999999.,.TRUE.,.TRUE.,2,work)
457    IF(l==1) THEN
458      CALL msg(5,"----------------------------------------------------------")
459      CALL msg(5,"$$$ Barycentrique interpolation for "//TRIM(title)//" $$$")
460      CALL msg(5,"----------------------------------------------------------")
461    END IF
462    IF(mode=='RUG') champ=LOG(champ)
463    CALL inter_barxy(dlon,dlat(:jmdep-1),champ,rlonu(:iim),rlatv,champint)
464    IF(mode=='RUG') THEN
465      champint=EXP(champint)
466      WHERE(NINT(mask)/=1) champint=0.001
467    END IF
468    champtime(:, :, l+1)=champint
469  END DO
470  CALL ncerr(NF90_CLOSE(ncid), fnam)
471
472!--- FIRST RECORD: LAST ONE OF PREVIOUS YEAR (CURRENT YEAR IF UNAVAILABLE)
473  fnam_m=fnam(1:idx)//'_m.nc'
474  IF(NF90_OPEN(fnam_m,NF90_NOWRITE,ncid)==NF90_NOERR) THEN
475    CALL msg(0,'Reading previous year file ("'//TRIM(fnam_m)//'") last record for '//TRIM(title))
476    CALL ncerr(NF90_INQ_VARID(ncid, varname, varid),fnam_m)
477    CALL ncerr(NF90_INQUIRE_VARIABLE(ncid, varid, dimids=dids),fnam_m)
478    CALL ncerr(NF90_INQUIRE_DIMENSION(ncid, dids(3), len=l), fnam_m)
479    CALL ncerr(NF90_GET_VAR(ncid,varid,champ,[1,1,l],[imdep,jmdep,1]),fnam_m)
480    CALL ncerr(NF90_CLOSE(ncid), fnam_m)
481    CALL conf_dat2d(title, dlon_ini, dlat_ini, dlon, dlat, champ, .TRUE.)
482    IF(extrp) CALL extrapol(champ,imdep,jmdep,999999.,.TRUE.,.TRUE.,2,work)
483    IF(mode=='RUG') champ=LOG(champ)
484    CALL inter_barxy(dlon,dlat(:jmdep-1),champ,rlonu(:iim),rlatv,champint)
485    IF(mode=='RUG') THEN
486      champint=EXP(champint)
487      WHERE(NINT(mask)/=1) champint=0.001
488    END IF
489    champtime(:, :, 1)=champint
490  ELSE
491    CALL msg(0,'Using current year file ("'//TRIM(fnam)//'") last record for '//TRIM(title))
492    champtime(:, :, 1)=champtime(:, :, lmdep+1)
493  END IF
494
495!--- LAST RECORD: FIRST ONE OF NEXT YEAR (CURRENT YEAR IF UNAVAILABLE)
496  fnam_p=fnam(1:idx)//'_p.nc'
497  IF(NF90_OPEN(fnam_p,NF90_NOWRITE,ncid)==NF90_NOERR) THEN
498    CALL msg(0,'Reading next year file ("'//TRIM(fnam_p)//'") first record for '//TRIM(title))
499    CALL ncerr(NF90_INQ_VARID(ncid, varname, varid),fnam_p)
500    CALL ncerr(NF90_GET_VAR(ncid,varid,champ,[1,1,1],[imdep,jmdep,1]),fnam_p)
501    CALL ncerr(NF90_CLOSE(ncid), fnam_p)
502    CALL conf_dat2d(title, dlon_ini, dlat_ini, dlon, dlat, champ, .TRUE.)
503    IF(extrp) CALL extrapol(champ,imdep,jmdep,999999.,.TRUE.,.TRUE.,2,work)
504    IF(mode=='RUG') champ=LOG(champ)
505    CALL inter_barxy(dlon,dlat(:jmdep-1),champ,rlonu(:iim),rlatv,champint)
506    IF(mode=='RUG') THEN
507      champint=EXP(champint)
508      WHERE(NINT(mask)/=1) champint=0.001
509    END IF
510    champtime(:, :, lmdep+2)=champint
511  ELSE
512    CALL msg(0,'Using current year file ("'//TRIM(fnam)//'") first record for '//TRIM(title))
513    champtime(:, :, lmdep+2)=champtime(:, :, 2)
514  END IF
515  DEALLOCATE(dlon_ini, dlat_ini, dlon, dlat, champ)
516  IF(extrp) DEALLOCATE(work)
517
518!--- TIME INTERPOLATION ------------------------------------------------------
519  IF(prt_level>0) THEN
520     IF(ndays/=ndays_in) THEN
521        WRITE(lunout, *)
522        WRITE(lunout,*)'DIFFERENT YEAR LENGTHS:'
523        WRITE(lunout,*)' In the input file: ',ndays_in
524        WRITE(lunout,*)' In the output file: ',ndays
525     END IF
526     IF(lmdep==ndays_in) THEN
527        WRITE(lunout, *)
528        WRITE(lunout, *)'NO TIME INTERPOLATION.'
529        WRITE(lunout, *)' Daily input file.'
530     ELSE
531        WRITE(lunout, *)'TIME INTERPOLATION.'
532        WRITE(lunout, *)' Input time vector: ', timeyear
533        WRITE(lunout, *)' Output time vector from 0 to ', ndays-1
534     END IF
535  END IF
536  ALLOCATE(yder(lmdep+2), champan(iip1, jjp1, ndays))
537  IF(lmdep==ndays_in) THEN
538     champan(1:iim,:,:)=champtime
539  ELSE
540     skip = .false.
541     n_extrap = 0
542     DO j=1, jjp1
543       DO i=1, iim
544         yder = pchsp_95(timeyear, champtime(i, j, :), ibeg=2, iend=2, &
545              vc_beg=0., vc_end=0.)
546         CALL pchfe_95(timeyear, champtime(i, j, :), yder, skip, &
547              arth(0., real(ndays_in) / ndays, ndays), champan(i, j, :), ierr)
548         if (ierr < 0) stop 1
549         n_extrap = n_extrap + ierr
550       END DO
551     END DO
552     IF(n_extrap /= 0) WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap
553  END IF
554  champan(iip1, :, :)=champan(1, :, :)
555  DEALLOCATE(yder, champtime, timeyear)
556
557!--- Checking the result
558  DO j=1, jjp1
559    CALL minmax(iip1, champan(1, j, 10), chmin, chmax)
560    IF (prt_level>5) WRITE(lunout, *)' ',TRIM(title),' at time 10 ', chmin, chmax, j
561  END DO
562
563!--- SPECIAL FILTER FOR SST: SST>271.38 --------------------------------------
564  IF(mode=='SST') THEN
565    CALL msg(0,'Filtering SST: SST >= 271.38')
566    WHERE(champan<271.38) champan=271.38
567  END IF
568
569!--- SPECIAL FILTER FOR SIC: 0.0<SIC<1.0 -------------------------------------
570  IF(mode=='SIC') THEN
571    CALL msg(0,'Filtering SIC: 0.0 < Sea-ice < 1.0')
572    IF(TRIM(unit_sic)=="1".OR.TRIM(unit_sic)=="1.0") THEN
573       ! Nothing to be done for sea-ice field is already in fraction of 1
574       ! This is the case for sea-ice in file cpl_atm_sic.nc
575       CALL msg(0,'Sea-ice field already in fraction of 1')
576    ELSE
577       ! Convert sea ice from percentage to fraction of 1
578       CALL msg(0,'Sea-ice field converted from percentage to fraction of 1.')
579       champan(:, :, :)=champan(:, :, :)/100.
580    END IF
581    champan(iip1, :, :)=champan(1, :, :)
582    WHERE(champan>1.0) champan=1.0
583    WHERE(champan<0.0) champan=0.0
584 END IF
585
586!--- DYNAMICAL TO PHYSICAL GRID ----------------------------------------------
587  ALLOCATE(champo(klon, ndays))
588  DO k=1, ndays
589    CALL gr_dyn_fi(1, iip1, jjp1, klon, champan(1, 1, k), champo(1, k))
590  END DO
591  DEALLOCATE(champan)
592
593END SUBROUTINE get_2Dfield
594!
595!-------------------------------------------------------------------------------
596
597
598!-------------------------------------------------------------------------------
599!
600SUBROUTINE start_init_orog0(lon_in,lat_in,phis,masque)
601!
602!-------------------------------------------------------------------------------
603  USE grid_noro_m, ONLY: grid_noro0
604  IMPLICIT NONE
605!===============================================================================
606! Purpose:  Compute "phis" just like it would be in start_init_orog.
607!===============================================================================
608! Arguments:
609  REAL,             INTENT(IN)    :: lon_in(:), lat_in(:)   ! dim (iml) (jml)
610  REAL,             INTENT(INOUT) :: phis(:,:), masque(:,:) ! dim (iml,jml)
611!-------------------------------------------------------------------------------
612! Local variables:
613  CHARACTER(LEN=256) :: modname="start_init_orog0"
614  INTEGER            :: fid, llm_tmp,ttm_tmp, iml,jml, iml_rel,jml_rel, itau(1)
615  REAL               :: lev(1), date, dt, deg2rad
616  REAL, ALLOCATABLE  :: lon_rad(:), lon_ini(:), lon_rel(:,:), relief_hi(:,:)
617  REAL, ALLOCATABLE  :: lat_rad(:), lat_ini(:), lat_rel(:,:)
618!-------------------------------------------------------------------------------
619  iml=assert_eq(SIZE(lon_in),SIZE(phis,1),SIZE(masque,1),TRIM(modname)//" iml")
620  jml=assert_eq(SIZE(lat_in),SIZE(phis,2),SIZE(masque,2),TRIM(modname)//" jml")
621  IF(iml/=iip1) CALL abort_gcm(TRIM(modname),'iml/=iip1',1)
622  IF(jml/=jjp1) CALL abort_gcm(TRIM(modname),'jml/=jjp1',1)
623  pi=2.0*ASIN(1.0); deg2rad=pi/180.0
624  IF(ANY(phis/=-99999.)) RETURN                  !--- phis ALREADY KNOWN
625
626!--- HIGH RESOLUTION OROGRAPHY
627  CALL flininfo(frelf, iml_rel, jml_rel, llm_tmp, ttm_tmp, fid)
628
629  ALLOCATE(lat_rel(iml_rel,jml_rel),lon_rel(iml_rel,jml_rel))
630  CALL flinopen(frelf, .FALSE., iml_rel, jml_rel, llm_tmp, lon_rel, lat_rel,   &
631                lev, ttm_tmp, itau, date, dt, fid)
632  ALLOCATE(relief_hi(iml_rel,jml_rel))
633  CALL flinget(fid, vrel, iml_rel, jml_rel, llm_tmp, ttm_tmp, 1, 1, relief_hi)
634  CALL flinclo(fid)
635
636!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
637  ALLOCATE(lon_ini(iml_rel),lat_ini(jml_rel))
638  lon_ini(:)=lon_rel(:,1); IF(MAXVAL(lon_rel)>pi) lon_ini=lon_ini*deg2rad
639  lat_ini(:)=lat_rel(1,:); IF(MAXVAL(lat_rel)>pi) lat_ini=lat_ini*deg2rad
640
641!--- FIELDS ARE PROCESSED TO BE ON STANDARD ANGULAR DOMAINS
642  ALLOCATE(lon_rad(iml_rel),lat_rad(jml_rel))
643  CALL conf_dat2d(vrel, lon_ini, lat_ini, lon_rad, lat_rad, relief_hi, .FALSE.)
644  DEALLOCATE(lon_ini,lat_ini)
645
646!--- COMPUTING SURFACE GEOPOTENTIAL USING ROUTINE grid_noro0
647  WRITE(lunout,*)
648  WRITE(lunout,*)'*** Compute surface geopotential ***'
649
650!--- CALL OROGRAPHY MODULE (REDUCED VERSION) TO COMPUTE FIELDS
651  CALL grid_noro0(lon_rad, lat_rad, relief_hi, lon_in, lat_in, phis, masque)
652  phis = phis * 9.81
653  phis(iml,:) = phis(1,:)
654  DEALLOCATE(relief_hi,lon_rad,lat_rad)
655
656END SUBROUTINE start_init_orog0
657!
658!-------------------------------------------------------------------------------
659
660
661!-------------------------------------------------------------------------------
662!
663SUBROUTINE msg(lev,str1,i,str2)
664!
665!-------------------------------------------------------------------------------
666! Arguments:
667  INTEGER,                    INTENT(IN) :: lev
668  CHARACTER(LEN=*),           INTENT(IN) :: str1
669  INTEGER,          OPTIONAL, INTENT(IN) :: i
670  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: str2
671!-------------------------------------------------------------------------------
672  IF(prt_level>lev) THEN
673    IF(PRESENT(str2)) THEN
674      WRITE(lunout,*) TRIM(str1), i, TRIM(str2)
675    ELSE IF(PRESENT(i)) THEN
676      WRITE(lunout,*) TRIM(str1), i
677    ELSE
678      WRITE(lunout,*) TRIM(str1)
679    END IF
680  END IF
681
682END SUBROUTINE msg
683!
684!-------------------------------------------------------------------------------
685
686
687!-------------------------------------------------------------------------------
688!
689SUBROUTINE ncerr(ncres,fnam)
690!
691!-------------------------------------------------------------------------------
692! Purpose: NetCDF errors handling.
693!-------------------------------------------------------------------------------
694  USE netcdf, ONLY : NF90_NOERR, NF90_STRERROR
695  IMPLICIT NONE
696!-------------------------------------------------------------------------------
697! Arguments:
698  INTEGER,          INTENT(IN) :: ncres
699  CHARACTER(LEN=*), INTENT(IN) :: fnam
700!-------------------------------------------------------------------------------
701  IF(ncres/=NF90_NOERR) THEN
702    WRITE(lunout,*)'Problem with file '//TRIM(fnam)//' in routine limit_netcdf.'
703    CALL abort_physic('limit_netcdf',NF90_STRERROR(ncres),1)
704  END IF
705
706END SUBROUTINE ncerr
707!
708!-------------------------------------------------------------------------------
709
710
711!-------------------------------------------------------------------------------
712!
713SUBROUTINE strclean(s)
714!
715!-------------------------------------------------------------------------------
716  IMPLICIT NONE
717!-------------------------------------------------------------------------------
718! Purpose: Remove tail null characters from the input string.
719!-------------------------------------------------------------------------------
720! Parameters:
721  CHARACTER(LEN=*), INTENT(INOUT) :: s
722!-------------------------------------------------------------------------------
723! Local variable:
724  INTEGER :: k
725!-------------------------------------------------------------------------------
726  k=LEN_TRIM(s); DO WHILE(ICHAR(s(k:k))==0); s(k:k)=' '; k=LEN_TRIM(s); END DO
727
728END SUBROUTINE strclean
729!
730!-------------------------------------------------------------------------------
731
732#endif
733! of #ifndef CPP_1D
734END SUBROUTINE limit_netcdf
735
736END MODULE limit
737!
738!*******************************************************************************
739
Note: See TracBrowser for help on using the repository browser.