[524] | 1 | ! |
---|
[1279] | 2 | ! $Id: limit_netcdf.F90 1402 2010-06-22 09:34:56Z dcugnet $ |
---|
[1319] | 3 | !------------------------------------------------------------------------------- |
---|
[524] | 4 | ! |
---|
[1319] | 5 | SUBROUTINE limit_netcdf(interbar, extrap, oldice, masque) |
---|
| 6 | ! |
---|
| 7 | !------------------------------------------------------------------------------- |
---|
| 8 | ! Author : L. Fairhead, 27/01/94 |
---|
| 9 | !------------------------------------------------------------------------------- |
---|
| 10 | ! Purpose: Boundary conditions files building for new model using climatologies. |
---|
| 11 | ! Both grids have to be regular. |
---|
| 12 | !------------------------------------------------------------------------------- |
---|
| 13 | ! Note: This routine is designed to work for Earth |
---|
| 14 | !------------------------------------------------------------------------------- |
---|
| 15 | ! Modification history: |
---|
| 16 | ! * 23/03/1994: Z. X. Li |
---|
| 17 | ! * 09/1999: L. Fairhead (netcdf reading in LMDZ.3.3) |
---|
| 18 | ! * 07/2001: P. Le Van |
---|
| 19 | ! * 11/2009: L. Guez (ozone day & night climatos, see etat0_netcdf.F90) |
---|
| 20 | ! * 12/2009: D. Cugnet (f77->f90, calendars, files from coupled runs) |
---|
| 21 | !------------------------------------------------------------------------------- |
---|
[1279] | 22 | #ifdef CPP_EARTH |
---|
[1319] | 23 | USE dimphy |
---|
| 24 | USE ioipsl, ONLY : ioget_year_len |
---|
| 25 | USE phys_state_var_mod, ONLY : pctsrf |
---|
| 26 | USE netcdf, ONLY : NF90_OPEN, NF90_CREATE, NF90_CLOSE, & |
---|
| 27 | NF90_DEF_DIM, NF90_DEF_VAR, NF90_PUT_VAR, NF90_PUT_ATT, & |
---|
| 28 | NF90_NOERR, NF90_NOWRITE, NF90_DOUBLE, NF90_GLOBAL, & |
---|
| 29 | NF90_CLOBBER, NF90_ENDDEF, NF90_UNLIMITED |
---|
[1323] | 30 | USE inter_barxy_m, only: inter_barxy |
---|
[1319] | 31 | #endif |
---|
| 32 | IMPLICIT NONE |
---|
| 33 | !------------------------------------------------------------------------------- |
---|
| 34 | ! Arguments: |
---|
[524] | 35 | #include "dimensions.h" |
---|
| 36 | #include "paramet.h" |
---|
[1319] | 37 | #include "iniprint.h" |
---|
| 38 | LOGICAL, INTENT(IN) :: interbar ! barycentric interpolation |
---|
| 39 | LOGICAL, INTENT(IN) :: extrap ! SST extrapolation flag |
---|
| 40 | LOGICAL, INTENT(IN) :: oldice ! old way ice computation |
---|
| 41 | REAL, DIMENSION(iip1,jjp1), INTENT(IN) :: masque ! land mask |
---|
| 42 | #ifndef CPP_EARTH |
---|
| 43 | WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics' |
---|
| 44 | #else |
---|
| 45 | !------------------------------------------------------------------------------- |
---|
| 46 | ! Local variables: |
---|
[524] | 47 | #include "control.h" |
---|
| 48 | #include "logic.h" |
---|
| 49 | #include "comvert.h" |
---|
| 50 | #include "comgeom2.h" |
---|
| 51 | #include "comconst.h" |
---|
| 52 | #include "indicesol.h" |
---|
| 53 | |
---|
[1319] | 54 | !--- For fractionary sub-cell use (old coding used soil index: 0,1,2,3) -------- |
---|
| 55 | LOGICAL, PARAMETER :: fracterre=.TRUE. |
---|
[989] | 56 | |
---|
[1319] | 57 | !--- INPUT NETCDF FILES NAMES -------------------------------------------------- |
---|
| 58 | CHARACTER(LEN=25) :: icefile, sstfile, dumstr |
---|
| 59 | CHARACTER(LEN=25), PARAMETER :: famipsst='amipbc_sst_1x1.nc ', & |
---|
| 60 | famipsic='amipbc_sic_1x1.nc ', & |
---|
| 61 | fclimsst='amipbc_sst_1x1_clim.nc ', & |
---|
| 62 | fclimsic='amipbc_sic_1x1_clim.nc ', & |
---|
| 63 | fcpldsst='cpl_atm_sst.nc ', & |
---|
| 64 | fcpldsic='cpl_atm_sic.nc ', & |
---|
| 65 | frugo ='Rugos.nc ', & |
---|
| 66 | falbe ='Albedo.nc ' |
---|
[524] | 67 | |
---|
[1319] | 68 | !--- OUTPUT VARIABLES FOR NETCDF FILE ------------------------------------------ |
---|
| 69 | REAL, DIMENSION(klon) :: fi_ice, verif |
---|
| 70 | REAL, DIMENSION(:,:), POINTER :: phy_rug=>NULL(), phy_ice=>NULL() |
---|
| 71 | REAL, DIMENSION(:,:), POINTER :: phy_sst=>NULL(), phy_alb=>NULL() |
---|
| 72 | REAL, DIMENSION(:,:), ALLOCATABLE :: phy_bil |
---|
| 73 | REAL, DIMENSION(:,:,:), ALLOCATABLE :: pctsrf_t |
---|
| 74 | INTEGER :: nbad |
---|
[524] | 75 | |
---|
[1319] | 76 | !--- VARIABLES FOR OUTPUT FILE WRITING ----------------------------------------- |
---|
| 77 | INTEGER :: ierr, nid, ndim, ntim, k |
---|
| 78 | INTEGER, DIMENSION(2) :: dims |
---|
| 79 | INTEGER :: id_tim, id_SST, id_BILS, id_RUG, id_ALB |
---|
| 80 | INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC |
---|
| 81 | INTEGER :: NF90_FORMAT |
---|
| 82 | LOGICAL :: lCPL !--- T: IPCC-IPSL cpl model output files |
---|
[1328] | 83 | INTEGER :: ndays !--- Depending on the output calendar |
---|
[524] | 84 | |
---|
[1319] | 85 | !--- INITIALIZATIONS ----------------------------------------------------------- |
---|
| 86 | #ifdef NC_DOUBLE |
---|
| 87 | NF90_FORMAT=NF90_DOUBLE |
---|
| 88 | #else |
---|
| 89 | NF90_FORMAT=NF90_FLOAT |
---|
| 90 | #endif |
---|
[524] | 91 | |
---|
[1319] | 92 | pi = 4.*ATAN(1.) |
---|
| 93 | rad = 6371229. |
---|
| 94 | daysec= 86400. |
---|
| 95 | omeg = 2.*pi/daysec |
---|
| 96 | g = 9.8 |
---|
| 97 | kappa = 0.2857143 |
---|
| 98 | cpp = 1004.70885 |
---|
| 99 | dtvr = daysec/FLOAT(day_step) |
---|
| 100 | CALL inigeom |
---|
[524] | 101 | |
---|
[1319] | 102 | !--- Beware: anneeref (from gcm.def) is used to determine output time sampling |
---|
| 103 | ndays=ioget_year_len(anneeref) |
---|
[524] | 104 | |
---|
[1319] | 105 | !--- RUGOSITY TREATMENT -------------------------------------------------------- |
---|
| 106 | WRITE(lunout,*) 'Traitement de la rugosite' |
---|
| 107 | CALL get_2Dfield(frugo,'RUG',interbar,ndays,phy_rug,mask=masque(1:iim,:)) |
---|
[524] | 108 | |
---|
[1319] | 109 | !--- OCEAN TREATMENT ----------------------------------------------------------- |
---|
| 110 | PRINT*, 'Traitement de la glace oceanique' ; icefile=''; lCPL=.FALSE. |
---|
[524] | 111 | |
---|
[1319] | 112 | ! 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 |
---|
| 123 | ierr=NF90_CLOSE(nid) |
---|
| 124 | WRITE(lunout,*)'Pour la glace de mer a ete choisi un fichier '//TRIM(dumstr) |
---|
[524] | 125 | |
---|
[1328] | 126 | CALL get_2Dfield(icefile,'SIC',interbar,ndays,phy_ice,flag=oldice,lCPL=lCPL) |
---|
[524] | 127 | |
---|
[1319] | 128 | ALLOCATE(pctsrf_t(klon,nbsrf,ndays)) |
---|
| 129 | 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 |
---|
[1328] | 136 | IF(lCPL) THEN ! SIC=pICE*(1-LIC-TER) |
---|
[1319] | 137 | pctsrf_t(:,is_sic,k)=fi_ice*(1-pctsrf(:,is_lic)-pctsrf(:,is_ter)) |
---|
| 138 | ELSE ! SIC=pICE-LIC |
---|
| 139 | 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 | pctsrf_t(:,is_sic,k)=0.0 |
---|
| 144 | pctsrf_t(:,is_oce,k)=0.0 |
---|
| 145 | ELSEWHERE |
---|
| 146 | 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 |
---|
| 149 | 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 |
---|
| 155 | 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 |
---|
| 187 | END DO |
---|
| 188 | DEALLOCATE(phy_ice) |
---|
[524] | 189 | |
---|
[1319] | 190 | !--- SST TREATMENT ------------------------------------------------------------- |
---|
| 191 | WRITE(lunout,*) 'Traitement de la sst' ; sstfile=''; lCPL=.FALSE. |
---|
[524] | 192 | |
---|
[1319] | 193 | ! 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 |
---|
| 204 | ierr=NF90_CLOSE(nid) |
---|
| 205 | WRITE(lunout,*)'Pour la temperature de mer a ete choisi un fichier '//TRIM(dumstr) |
---|
[524] | 206 | |
---|
[1319] | 207 | CALL get_2Dfield(trim(sstfile),'SST',interbar,ndays,phy_sst,flag=extrap) |
---|
[524] | 208 | |
---|
[1319] | 209 | !--- ALBEDO TREATMENT ---------------------------------------------------------- |
---|
| 210 | WRITE(lunout,*) 'Traitement de l albedo' |
---|
| 211 | CALL get_2Dfield(falbe,'ALB',interbar,ndays,phy_alb) |
---|
[524] | 212 | |
---|
[1319] | 213 | !--- REFERENCE GROUND HEAT FLUX TREATMENT -------------------------------------- |
---|
| 214 | ALLOCATE(phy_bil(klon,ndays)); phy_bil=0.0 |
---|
[524] | 215 | |
---|
[1319] | 216 | !--- OUTPUT FILE WRITING ------------------------------------------------------- |
---|
| 217 | WRITE(lunout,*) 'Ecriture du fichier limit' |
---|
[524] | 218 | |
---|
[1319] | 219 | !--- File creation |
---|
| 220 | ierr=NF90_CREATE("limit.nc",NF90_CLOBBER,nid) |
---|
| 221 | ierr=NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier conditions aux limites") |
---|
[524] | 222 | |
---|
[1319] | 223 | !--- Dimensions creation |
---|
| 224 | ierr=NF90_DEF_DIM(nid,"points_physiques",klon,ndim) |
---|
| 225 | ierr=NF90_DEF_DIM(nid,"time",NF90_UNLIMITED,ntim) |
---|
[524] | 226 | |
---|
[1319] | 227 | dims=(/ndim,ntim/) |
---|
[524] | 228 | |
---|
[1319] | 229 | !--- Variables creation |
---|
[1328] | 230 | ierr=NF90_DEF_VAR(nid,"TEMPS",NF90_FORMAT,(/ntim/),id_tim) |
---|
[1319] | 231 | ierr=NF90_DEF_VAR(nid,"FOCE", NF90_FORMAT,dims,id_FOCE) |
---|
| 232 | ierr=NF90_DEF_VAR(nid,"FSIC", NF90_FORMAT,dims,id_FSIC) |
---|
| 233 | ierr=NF90_DEF_VAR(nid,"FTER", NF90_FORMAT,dims,id_FTER) |
---|
| 234 | ierr=NF90_DEF_VAR(nid,"FLIC", NF90_FORMAT,dims,id_FLIC) |
---|
| 235 | ierr=NF90_DEF_VAR(nid,"SST", NF90_FORMAT,dims,id_SST) |
---|
| 236 | ierr=NF90_DEF_VAR(nid,"BILS", NF90_FORMAT,dims,id_BILS) |
---|
| 237 | ierr=NF90_DEF_VAR(nid,"ALB", NF90_FORMAT,dims,id_ALB) |
---|
| 238 | ierr=NF90_DEF_VAR(nid,"RUG", NF90_FORMAT,dims,id_RUG) |
---|
[524] | 239 | |
---|
[1319] | 240 | !--- Attributes creation |
---|
| 241 | ierr=NF90_PUT_ATT(nid,id_tim, "title","Jour dans l annee") |
---|
| 242 | ierr=NF90_PUT_ATT(nid,id_FOCE,"title","Fraction ocean") |
---|
| 243 | ierr=NF90_PUT_ATT(nid,id_FSIC,"title","Fraction glace de mer") |
---|
| 244 | ierr=NF90_PUT_ATT(nid,id_FTER,"title","Fraction terre") |
---|
| 245 | ierr=NF90_PUT_ATT(nid,id_FLIC,"title","Fraction land ice") |
---|
| 246 | ierr=NF90_PUT_ATT(nid,id_SST ,"title","Temperature superficielle de la mer") |
---|
| 247 | ierr=NF90_PUT_ATT(nid,id_BILS,"title","Reference flux de chaleur au sol") |
---|
| 248 | ierr=NF90_PUT_ATT(nid,id_ALB, "title","Albedo a la surface") |
---|
| 249 | ierr=NF90_PUT_ATT(nid,id_RUG, "title","Rugosite") |
---|
[524] | 250 | |
---|
[1319] | 251 | ierr=NF90_ENDDEF(nid) |
---|
| 252 | |
---|
| 253 | !--- Variables saving |
---|
[1328] | 254 | ierr=NF90_PUT_VAR(nid,id_tim,(/(REAL(k),k=1,ndays)/)) |
---|
[1319] | 255 | ierr=NF90_PUT_VAR(nid,id_FOCE,pctsrf_t(:,is_oce,:),(/1,1/),(/klon,ndays/)) |
---|
| 256 | ierr=NF90_PUT_VAR(nid,id_FSIC,pctsrf_t(:,is_sic,:),(/1,1/),(/klon,ndays/)) |
---|
| 257 | ierr=NF90_PUT_VAR(nid,id_FTER,pctsrf_t(:,is_ter,:),(/1,1/),(/klon,ndays/)) |
---|
| 258 | ierr=NF90_PUT_VAR(nid,id_FLIC,pctsrf_t(:,is_lic,:),(/1,1/),(/klon,ndays/)) |
---|
| 259 | ierr=NF90_PUT_VAR(nid,id_SST ,phy_sst(:,:),(/1,1/),(/klon,ndays/)) |
---|
| 260 | ierr=NF90_PUT_VAR(nid,id_BILS,phy_bil(:,:),(/1,1/),(/klon,ndays/)) |
---|
| 261 | ierr=NF90_PUT_VAR(nid,id_ALB ,phy_alb(:,:),(/1,1/),(/klon,ndays/)) |
---|
| 262 | ierr=NF90_PUT_VAR(nid,id_RUG ,phy_rug(:,:),(/1,1/),(/klon,ndays/)) |
---|
| 263 | |
---|
| 264 | ierr=NF90_CLOSE(nid) |
---|
| 265 | |
---|
| 266 | DEALLOCATE(pctsrf_t,phy_sst,phy_bil,phy_alb,phy_rug) |
---|
[524] | 267 | #endif |
---|
[1319] | 268 | ! of #ifdef CPP_EARTH |
---|
| 269 | STOP |
---|
[524] | 270 | |
---|
| 271 | |
---|
[1319] | 272 | !=============================================================================== |
---|
| 273 | ! |
---|
| 274 | CONTAINS |
---|
| 275 | ! |
---|
| 276 | !=============================================================================== |
---|
[524] | 277 | |
---|
| 278 | |
---|
[1319] | 279 | !------------------------------------------------------------------------------- |
---|
| 280 | ! |
---|
[1328] | 281 | SUBROUTINE get_2Dfield(fnam, mode, ibar, ndays, champo, flag, mask, lCPL) |
---|
[1319] | 282 | ! |
---|
| 283 | !------------------------------------------------------------------------------- |
---|
| 284 | ! Comments: |
---|
| 285 | ! There are two assumptions concerning the NetCDF files, that are satisfied |
---|
| 286 | ! with files that are conforming NC convention: |
---|
| 287 | ! 1) The last dimension of the variables used is the time record. |
---|
| 288 | ! 2) Dimensional variables have the same names as corresponding dimensions. |
---|
| 289 | !------------------------------------------------------------------------------- |
---|
| 290 | USE netcdf, ONLY : NF90_OPEN, NF90_INQ_VARID, NF90_INQUIRE_VARIABLE, & |
---|
| 291 | NF90_CLOSE, NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION, & |
---|
| 292 | NF90_GET_VAR, NF90_GET_ATT |
---|
| 293 | USE dimphy, ONLY : klon |
---|
| 294 | USE phys_state_var_mod, ONLY : pctsrf |
---|
| 295 | IMPLICIT NONE |
---|
| 296 | #include "dimensions.h" |
---|
| 297 | #include "paramet.h" |
---|
| 298 | #include "comgeom2.h" |
---|
| 299 | #include "control.h" |
---|
| 300 | #include "indicesol.h" |
---|
| 301 | #include "iniprint.h" |
---|
| 302 | !------------------------------------------------------------------------------- |
---|
| 303 | ! Arguments: |
---|
| 304 | CHARACTER(LEN=*), INTENT(IN) :: fnam ! NetCDF file name |
---|
| 305 | CHARACTER(LEN=3), INTENT(IN) :: mode ! RUG, SIC, SST or ALB |
---|
| 306 | LOGICAL, INTENT(IN) :: ibar ! interp on pressure levels |
---|
| 307 | INTEGER, INTENT(IN) :: ndays ! current year number of days |
---|
| 308 | REAL, POINTER, DIMENSION(:,:) :: champo ! output field = f(t) |
---|
[1328] | 309 | LOGICAL, OPTIONAL, INTENT(IN) :: flag ! extrapol. (SST) old ice (SIC) |
---|
[1319] | 310 | REAL, OPTIONAL, DIMENSION(iim,jjp1), INTENT(IN) :: mask |
---|
[1328] | 311 | LOGICAL, OPTIONAL, INTENT(IN) :: lCPL ! Coupled model flag (for ICE) |
---|
[1319] | 312 | !------------------------------------------------------------------------------- |
---|
| 313 | ! Local variables: |
---|
| 314 | !--- NetCDF |
---|
| 315 | INTEGER :: ierr, ncid, varid ! NetCDF identifiers |
---|
| 316 | CHARACTER(LEN=30) :: dnam ! dimension name |
---|
| 317 | CHARACTER(LEN=80) :: varname ! NetCDF variable name |
---|
| 318 | !--- dimensions |
---|
| 319 | INTEGER, DIMENSION(4) :: dids ! NetCDF dimensions identifiers |
---|
| 320 | REAL, ALLOCATABLE, DIMENSION(:) :: dlon_ini ! initial longitudes vector |
---|
| 321 | REAL, ALLOCATABLE, DIMENSION(:) :: dlat_ini ! initial latitudes vector |
---|
| 322 | REAL, POINTER, DIMENSION(:) :: dlon, dlat ! reordered lon/lat vectors |
---|
| 323 | !--- fields |
---|
| 324 | INTEGER :: imdep, jmdep, lmdep ! dimensions of 'champ' |
---|
[1323] | 325 | REAL, ALLOCATABLE, DIMENSION(:,:) :: champ ! wanted field on initial grid |
---|
[1319] | 326 | REAL, ALLOCATABLE, DIMENSION(:) :: yder, timeyear |
---|
| 327 | REAL, DIMENSION(iim,jjp1) :: champint ! interpolated field |
---|
| 328 | REAL, ALLOCATABLE, DIMENSION(:,:,:) :: champtime |
---|
| 329 | REAL, ALLOCATABLE, DIMENSION(:,:,:) :: champan |
---|
| 330 | REAL :: time, by |
---|
| 331 | !--- input files |
---|
| 332 | CHARACTER(LEN=20) :: cal_in ! calendar |
---|
| 333 | INTEGER :: ndays_in ! number of days |
---|
| 334 | !--- misc |
---|
| 335 | INTEGER :: i, j, k, l ! loop counters |
---|
| 336 | REAL, ALLOCATABLE, DIMENSION(:,:) :: work ! used for extrapolation |
---|
| 337 | CHARACTER(LEN=25) :: title ! for messages |
---|
| 338 | LOGICAL :: extrp ! flag for extrapolation |
---|
| 339 | REAL :: chmin, chmax |
---|
| 340 | !------------------------------------------------------------------------------- |
---|
| 341 | !---Variables depending on keyword 'mode' -------------------------------------- |
---|
| 342 | NULLIFY(champo) |
---|
| 343 | SELECT CASE(mode) |
---|
| 344 | CASE('RUG'); varname='RUGOS'; title='Rugosite' |
---|
| 345 | CASE('SIC'); varname='sicbcs'; title='Sea-ice' |
---|
| 346 | CASE('SST'); varname='tosbcs'; title='SST' |
---|
| 347 | CASE('ALB'); varname='ALBEDO'; title='Albedo' |
---|
| 348 | END SELECT |
---|
[524] | 349 | |
---|
[1402] | 350 | extrp=.FALSE. |
---|
| 351 | IF ( PRESENT(flag) ) THEN |
---|
| 352 | IF ( flag .AND. mode=='SST' ) extrp=.TRUE. |
---|
| 353 | END IF |
---|
| 354 | |
---|
[1319] | 355 | !--- GETTING SOME DIMENSIONAL VARIABLES FROM FILE ------------------------------ |
---|
| 356 | ierr=NF90_OPEN(fnam,NF90_NOWRITE,ncid); CALL ncerr(ierr,fnam) |
---|
| 357 | ierr=NF90_INQ_VARID(ncid,varname,varid); CALL ncerr(ierr,fnam) |
---|
| 358 | ierr=NF90_INQUIRE_VARIABLE(ncid,varid,dimids=dids); CALL ncerr(ierr,fnam) |
---|
[524] | 359 | |
---|
[1319] | 360 | !--- Longitude |
---|
| 361 | ierr=NF90_INQUIRE_DIMENSION(ncid,dids(1),name=dnam,len=imdep) |
---|
| 362 | CALL ncerr(ierr,fnam); ALLOCATE(dlon_ini(imdep),dlon(imdep)) |
---|
| 363 | ierr=NF90_INQ_VARID(ncid,dnam,varid); CALL ncerr(ierr,fnam) |
---|
| 364 | ierr=NF90_GET_VAR(ncid,varid,dlon_ini); CALL ncerr(ierr,fnam) |
---|
| 365 | WRITE(lunout,*) 'variable ', dnam, 'dimension ', imdep |
---|
[524] | 366 | |
---|
[1319] | 367 | !--- Latitude |
---|
| 368 | ierr=NF90_INQUIRE_DIMENSION(ncid,dids(2),name=dnam,len=jmdep) |
---|
| 369 | CALL ncerr(ierr,fnam); ALLOCATE(dlat_ini(jmdep),dlat(jmdep)) |
---|
| 370 | ierr=NF90_INQ_VARID(ncid,dnam,varid); CALL ncerr(ierr,fnam) |
---|
| 371 | ierr=NF90_GET_VAR(ncid,varid,dlat_ini); CALL ncerr(ierr,fnam) |
---|
| 372 | WRITE(lunout,*) 'variable ', dnam, 'dimension ', jmdep |
---|
[524] | 373 | |
---|
[1319] | 374 | !--- Time (variable is not needed - it is rebuilt - but calendar is) |
---|
| 375 | ierr=NF90_INQUIRE_DIMENSION(ncid,dids(3),name=dnam,len=lmdep) |
---|
| 376 | CALL ncerr(ierr,fnam); ALLOCATE(timeyear(lmdep)) |
---|
| 377 | ierr=NF90_INQ_VARID(ncid,dnam,varid); CALL ncerr(ierr,fnam) |
---|
| 378 | cal_in=' ' |
---|
| 379 | ierr=NF90_GET_ATT(ncid,varid,'calendar',cal_in) |
---|
| 380 | IF(ierr/=NF90_NOERR) THEN |
---|
| 381 | SELECT CASE(mode) |
---|
| 382 | CASE('RUG','ALB'); cal_in='360d' |
---|
| 383 | CASE('SIC','SST'); cal_in='gregorian' |
---|
| 384 | END SELECT |
---|
| 385 | WRITE(lunout,*)'ATTENTION: variable ''time'' sans attribut ''calendrier'' d& |
---|
| 386 | &ans '//TRIM(fnam)//'. On choisit la valeur par defaut.' |
---|
| 387 | END IF |
---|
| 388 | WRITE(lunout,*) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', cal_in |
---|
[524] | 389 | |
---|
[1319] | 390 | !--- CONSTRUCTING THE INPUT TIME VECTOR FOR INTERPOLATION ---------------------- |
---|
| 391 | !--- Determining input file number of days, depending on calendar |
---|
| 392 | ndays_in=year_len(anneeref,cal_in) |
---|
[524] | 393 | |
---|
[1319] | 394 | !--- Time vector reconstruction (time vector from file is not trusted) |
---|
| 395 | !--- If input records are not monthly, time sampling has to be constant ! |
---|
| 396 | timeyear=mid_months(anneeref,cal_in,lmdep) |
---|
| 397 | IF(lmdep/=12) WRITE(lunout,'(a,i3,a)')'Note: les fichiers de '//TRIM(mode) & |
---|
[1328] | 398 | //' ne comportent pas 12, mais ',lmdep,' enregistrements.' |
---|
[524] | 399 | |
---|
[1319] | 400 | !--- GETTING THE FIELD AND INTERPOLATING IT ------------------------------------ |
---|
[1323] | 401 | ALLOCATE(champ(imdep,jmdep),champtime(iim,jjp1,lmdep)) |
---|
[1319] | 402 | IF(extrp) ALLOCATE(work(imdep,jmdep)) |
---|
[524] | 403 | |
---|
[1319] | 404 | WRITE(lunout,*) |
---|
| 405 | WRITE(lunout,'(a,i3,a)')'LECTURE ET INTERPOLATION HORIZ. DE ',lmdep,' CHAMPS.' |
---|
| 406 | ierr=NF90_INQ_VARID(ncid,varname,varid); CALL ncerr(ierr,fnam) |
---|
| 407 | DO l=1,lmdep |
---|
| 408 | ierr=NF90_GET_VAR(ncid,varid,champ,(/1,1,l/),(/imdep,jmdep,1/)) |
---|
| 409 | CALL ncerr(ierr,fnam) |
---|
| 410 | CALL conf_dat2d(title,imdep,jmdep,dlon_ini,dlat_ini,dlon,dlat,champ,ibar) |
---|
[524] | 411 | |
---|
[1319] | 412 | IF(extrp) CALL extrapol(champ,imdep,jmdep,999999.,.TRUE.,.TRUE.,2,work) |
---|
[524] | 413 | |
---|
[1319] | 414 | IF(ibar.AND..NOT.(mode=='SIC'.AND.flag)) THEN |
---|
| 415 | IF(l==1) THEN |
---|
| 416 | WRITE(lunout,*) & |
---|
| 417 | '-------------------------------------------------------------------------' |
---|
| 418 | WRITE(lunout,*) & |
---|
| 419 | '$$$ Utilisation de l''interpolation barycentrique pour '//TRIM(title)//' $$$' |
---|
| 420 | WRITE(lunout,*) & |
---|
| 421 | '-------------------------------------------------------------------------' |
---|
| 422 | END IF |
---|
| 423 | IF(mode=='RUG') champ=LOG(champ) |
---|
[1323] | 424 | CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim), & |
---|
| 425 | rlatv, champint) |
---|
[1319] | 426 | IF(mode=='RUG') THEN |
---|
| 427 | champint=EXP(champint) |
---|
| 428 | WHERE(NINT(mask)/=1) champint=0.001 |
---|
| 429 | END IF |
---|
| 430 | ELSE |
---|
| 431 | SELECT CASE(mode) |
---|
[1323] | 432 | CASE('RUG'); CALL rugosite(imdep, jmdep, dlon, dlat, champ, & |
---|
[1319] | 433 | iim, jjp1, rlonv, rlatu, champint, mask) |
---|
[1323] | 434 | CASE('SIC'); CALL sea_ice (imdep, jmdep, dlon, dlat, champ, & |
---|
[1319] | 435 | iim, jjp1, rlonv, rlatu, champint) |
---|
[1323] | 436 | CASE('SST','ALB'); CALL grille_m(imdep, jmdep, dlon, dlat, champ, & |
---|
[1319] | 437 | iim, jjp1, rlonv, rlatu, champint) |
---|
| 438 | END SELECT |
---|
| 439 | END IF |
---|
| 440 | champtime(:,:,l)=champint |
---|
| 441 | END DO |
---|
| 442 | ierr=NF90_CLOSE(ncid); CALL ncerr(ierr,fnam) |
---|
[524] | 443 | |
---|
[1319] | 444 | DEALLOCATE(dlon_ini,dlat_ini,dlon,dlat,champ) |
---|
| 445 | IF(extrp) DEALLOCATE(work) |
---|
[524] | 446 | |
---|
[1319] | 447 | !--- TIME INTERPOLATION -------------------------------------------------------- |
---|
| 448 | WRITE(lunout,*) |
---|
| 449 | WRITE(lunout,*)'INTERPOLATION TEMPORELLE.' |
---|
| 450 | WRITE(lunout,"(2x,' Vecteur temps en entree: ',10f6.1)") timeyear |
---|
| 451 | WRITE(lunout,"(2x,' Vecteur temps en sortie de 0 a ',i3)") ndays |
---|
| 452 | ALLOCATE(yder(lmdep),champan(iip1,jjp1,ndays)) |
---|
| 453 | DO j=1,jjp1 |
---|
| 454 | DO i=1,iim |
---|
| 455 | CALL spline(timeyear,champtime(i,j,:),lmdep,1.e30,1.e30,yder) |
---|
| 456 | DO k=1,ndays |
---|
| 457 | time=FLOAT((k-1)*ndays_in)/FLOAT(ndays) |
---|
| 458 | CALL splint(timeyear,champtime(i,j,:),yder,lmdep,time,by) |
---|
| 459 | champan(i,j,k) = by |
---|
| 460 | END DO |
---|
| 461 | END DO |
---|
| 462 | END DO |
---|
| 463 | champan(iip1,:,:)=champan(1,:,:) |
---|
| 464 | DEALLOCATE(yder,champtime,timeyear) |
---|
[524] | 465 | |
---|
[1319] | 466 | !--- Checking the result |
---|
| 467 | DO j=1,jjp1 |
---|
| 468 | CALL minmax(iip1,champan(1,j,10),chmin,chmax) |
---|
| 469 | WRITE(lunout,*)' '//TRIM(title)//' au temps 10 ',chmin,chmax,j |
---|
| 470 | END DO |
---|
[524] | 471 | |
---|
[1319] | 472 | !--- SPECIAL FILTER FOR SST: SST>271.38 ---------------------------------------- |
---|
| 473 | IF(mode=='SST') THEN |
---|
| 474 | WRITE(lunout,*) 'Filtrage de la SST: SST >= 271.38' |
---|
| 475 | WHERE(champan<271.38) champan=271.38 |
---|
| 476 | END IF |
---|
[524] | 477 | |
---|
[1319] | 478 | !--- SPECIAL FILTER FOR SIC: 0.0<SIC<1.0 --------------------------------------- |
---|
| 479 | IF(mode=='SIC') THEN |
---|
| 480 | WRITE(lunout,*) 'Filtrage de la SIC: 0.0 < Sea-ice < 1.0' |
---|
[1328] | 481 | IF(.NOT.lCPL) champan(:,:,:)=champan(:,:,:)/100. |
---|
[1319] | 482 | champan(iip1,:,:)=champan(1,:,:) |
---|
| 483 | WHERE(champan>1.0) champan=1.0 |
---|
| 484 | WHERE(champan<0.0) champan=0.0 |
---|
| 485 | END IF |
---|
[524] | 486 | |
---|
[1319] | 487 | !--- DYNAMICAL TO PHYSICAL GRID ------------------------------------------------ |
---|
| 488 | ALLOCATE(champo(klon,ndays)) |
---|
| 489 | DO k=1,ndays |
---|
| 490 | CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k),champo(1,k)) |
---|
| 491 | END DO |
---|
| 492 | DEALLOCATE(champan) |
---|
[1328] | 493 | |
---|
[1319] | 494 | END SUBROUTINE get_2Dfield |
---|
| 495 | ! |
---|
| 496 | !------------------------------------------------------------------------------- |
---|
[524] | 497 | |
---|
| 498 | |
---|
| 499 | |
---|
[1319] | 500 | !------------------------------------------------------------------------------- |
---|
| 501 | ! |
---|
| 502 | FUNCTION year_len(y,cal_in) |
---|
| 503 | ! |
---|
| 504 | !------------------------------------------------------------------------------- |
---|
| 505 | USE ioipsl, ONLY : ioget_calendar,ioconf_calendar,lock_calendar,ioget_year_len |
---|
| 506 | IMPLICIT NONE |
---|
| 507 | !------------------------------------------------------------------------------- |
---|
| 508 | ! Arguments: |
---|
| 509 | INTEGER :: year_len |
---|
| 510 | INTEGER, INTENT(IN) :: y |
---|
| 511 | CHARACTER(LEN=*), INTENT(IN) :: cal_in |
---|
| 512 | !------------------------------------------------------------------------------- |
---|
| 513 | ! Local variables: |
---|
| 514 | CHARACTER(LEN=20) :: cal_out ! calendar (for outputs) |
---|
| 515 | !------------------------------------------------------------------------------- |
---|
| 516 | !--- Getting the input calendar to reset at the end of the function |
---|
| 517 | CALL ioget_calendar(cal_out) |
---|
[524] | 518 | |
---|
[1319] | 519 | !--- Unlocking calendar and setting it to wanted one |
---|
| 520 | CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in)) |
---|
[524] | 521 | |
---|
[1319] | 522 | !--- Getting the number of days in this year |
---|
| 523 | year_len=ioget_year_len(y) |
---|
[524] | 524 | |
---|
[1319] | 525 | !--- Back to original calendar |
---|
| 526 | CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out)) |
---|
[524] | 527 | |
---|
[1319] | 528 | END FUNCTION year_len |
---|
| 529 | ! |
---|
| 530 | !------------------------------------------------------------------------------- |
---|
[524] | 531 | |
---|
| 532 | |
---|
[1319] | 533 | !------------------------------------------------------------------------------- |
---|
| 534 | ! |
---|
| 535 | FUNCTION mid_months(y,cal_in,nm) |
---|
| 536 | ! |
---|
| 537 | !------------------------------------------------------------------------------- |
---|
| 538 | USE ioipsl, ONLY : ioget_calendar,ioconf_calendar,lock_calendar,ioget_mon_len |
---|
| 539 | IMPLICIT NONE |
---|
| 540 | !------------------------------------------------------------------------------- |
---|
| 541 | ! Arguments: |
---|
| 542 | INTEGER, INTENT(IN) :: y ! year |
---|
| 543 | CHARACTER(LEN=*), INTENT(IN) :: cal_in ! calendar |
---|
| 544 | INTEGER, INTENT(IN) :: nm ! months/year number |
---|
| 545 | REAL, DIMENSION(nm) :: mid_months ! mid-month times |
---|
| 546 | !------------------------------------------------------------------------------- |
---|
| 547 | ! Local variables: |
---|
| 548 | CHARACTER(LEN=99) :: mess ! error message |
---|
| 549 | CHARACTER(LEN=20) :: cal_out ! calendar (for outputs) |
---|
| 550 | INTEGER, DIMENSION(nm) :: mnth ! months lengths (days) |
---|
| 551 | INTEGER :: m ! months counter |
---|
| 552 | INTEGER :: nd ! number of days |
---|
| 553 | !------------------------------------------------------------------------------- |
---|
| 554 | nd=year_len(y,cal_in) |
---|
[524] | 555 | |
---|
[1319] | 556 | IF(nm==12) THEN |
---|
[524] | 557 | |
---|
[1319] | 558 | !--- Getting the input calendar to reset at the end of the function |
---|
| 559 | CALL ioget_calendar(cal_out) |
---|
[524] | 560 | |
---|
[1319] | 561 | !--- Unlocking calendar and setting it to wanted one |
---|
| 562 | CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in)) |
---|
[524] | 563 | |
---|
[1319] | 564 | !--- Getting the length of each month |
---|
| 565 | DO m=1,nm; mnth(m)=ioget_mon_len(y,m); END DO |
---|
[524] | 566 | |
---|
[1319] | 567 | !--- Back to original calendar |
---|
| 568 | CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out)) |
---|
[524] | 569 | |
---|
[1319] | 570 | ELSE IF(MODULO(nd,nm)/=0) THEN |
---|
| 571 | WRITE(mess,'(a,i3,a,i3,a)')'Unconsistent calendar: ',nd,' days/year, but ',& |
---|
| 572 | nm,' months/year. Months number should divide days number.' |
---|
| 573 | CALL abort_gcm('mid_months',TRIM(mess),1) |
---|
[524] | 574 | |
---|
[1319] | 575 | ELSE |
---|
| 576 | mnth=(/(m,m=1,nm,nd/nm)/) |
---|
| 577 | END IF |
---|
[524] | 578 | |
---|
[1319] | 579 | !--- Mid-months times |
---|
| 580 | mid_months(1)=0.5*FLOAT(mnth(1)) |
---|
| 581 | DO k=2,nm |
---|
| 582 | mid_months(k)=mid_months(k-1)+0.5*FLOAT(mnth(k-1)+mnth(k)) |
---|
| 583 | END DO |
---|
[524] | 584 | |
---|
[1319] | 585 | END FUNCTION mid_months |
---|
| 586 | ! |
---|
| 587 | !------------------------------------------------------------------------------- |
---|
[524] | 588 | |
---|
| 589 | |
---|
[1319] | 590 | !------------------------------------------------------------------------------- |
---|
| 591 | ! |
---|
| 592 | SUBROUTINE ncerr(ncres,fnam) |
---|
| 593 | ! |
---|
| 594 | !------------------------------------------------------------------------------- |
---|
| 595 | ! Purpose: NetCDF errors handling. |
---|
| 596 | !------------------------------------------------------------------------------- |
---|
| 597 | USE netcdf, ONLY : NF90_NOERR, NF90_STRERROR |
---|
| 598 | IMPLICIT NONE |
---|
| 599 | !------------------------------------------------------------------------------- |
---|
| 600 | ! Arguments: |
---|
| 601 | INTEGER, INTENT(IN) :: ncres |
---|
| 602 | CHARACTER(LEN=*), INTENT(IN) :: fnam |
---|
| 603 | !------------------------------------------------------------------------------- |
---|
| 604 | #include "iniprint.h" |
---|
| 605 | IF(ncres/=NF90_NOERR) THEN |
---|
| 606 | WRITE(lunout,*)'Problem with file '//TRIM(fnam)//' in routine limit_netcdf.' |
---|
| 607 | CALL abort_gcm('limit_netcdf',NF90_STRERROR(ncres),1) |
---|
| 608 | END IF |
---|
[524] | 609 | |
---|
[1319] | 610 | END SUBROUTINE ncerr |
---|
| 611 | ! |
---|
| 612 | !------------------------------------------------------------------------------- |
---|
| 613 | |
---|
| 614 | |
---|
| 615 | END SUBROUTINE limit_netcdf |
---|