Changeset 3411 for LMDZ6/branches/DYNAMICO-conv/libf/dynphy_lonlat
- Timestamp:
- Nov 5, 2018, 3:24:59 PM (6 years ago)
- Location:
- LMDZ6/branches/DYNAMICO-conv
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/DYNAMICO-conv
- Property svn:mergeinfo changed
/LMDZ6/trunk removed
- Property svn:mergeinfo changed
-
LMDZ6/branches/DYNAMICO-conv/libf/dynphy_lonlat/phylmd/iniphysiq_mod.F90
r3356 r3411 46 46 USE ioipsl_getin_p_mod, ONLY: getin_p 47 47 USE slab_heat_transp_mod, ONLY: ini_slab_transp_geom 48 #ifdef REPROBUS49 USE CHEM_REP, ONLY : Init_chem_rep_phys50 #endif51 48 IMPLICIT NONE 52 49 … … 181 178 rlonudyn,rlatudyn,rlonvdyn,rlatvdyn) 182 179 #endif 183 IF (type_trac == 'repr') THEN184 #ifdef REPROBUS185 CALL Init_chem_rep_phys(klon_omp,nbp_lev)186 #endif187 END IF188 180 END IF 189 181 -
LMDZ6/branches/DYNAMICO-conv/libf/dynphy_lonlat/phylmd/limit_netcdf.F90
r3356 r3411 27 27 USE init_ssrf_m, ONLY: start_init_subsurf 28 28 29 INTEGER, PARAMETER :: ns=256 30 CHARACTER(LEN=ns), PARAMETER :: & 29 CHARACTER(LEN=20), PARAMETER :: & 31 30 fsst(5)=['amipbc_sst_1x1.nc ','amip_sst_1x1.nc ','cpl_atm_sst.nc '& 32 ,'histmth_sst.nc ','sstk.nc '], & 31 ,'histmth_sst.nc ','sstk.nc '] 32 CHARACTER(LEN=20), PARAMETER :: & 33 33 fsic(5)=['amipbc_sic_1x1.nc ','amip_sic_1x1.nc ','cpl_atm_sic.nc '& 34 ,'histmth_sic.nc ','ci.nc '], & 34 ,'histmth_sic.nc ','ci.nc '] 35 CHARACTER(LEN=10), PARAMETER :: & 35 36 vsst(5)=['tosbcs ','tos ','SISUTESW ','tsol_oce ','sstk '], & 36 vsic(5)=['sicbcs ','sic ','SIICECOV ','pourc_sic ','ci '], & 37 frugo='Rugos.nc ', falbe='Albedo.nc ', frelf='Relief.nc ', & 38 vrug='RUGOS ', valb='ALBEDO ', vrel='RELIEF ', & 39 DegK(11)=['degK ','degree_K ','degreeK ','deg_K '& 40 ,'degsK ','degrees_K ','degreesK ','degs_K '& 41 ,'degree_kelvin ','degrees_kelvin','K '], & 42 DegC(10)=['degC ','degree_C ','degreeC ','deg_C '& 43 ,'degsC ','degrees_C ','degreesC ','degs_C '& 44 ,'degree_Celsius','celsius '], & 45 Perc(2) =['% ','percent '], & 46 Frac(2) =['1.0 ','1 '] 37 vsic(5)=['sicbcs ','sic ','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 ' 47 41 48 42 CONTAINS … … 92 86 include "comgeom2.h" 93 87 94 !--- INPUT NETCDF FILES AND VARIABLES NAMES ------------------------------------ 95 CHARACTER(LEN=ns) :: icefile, sstfile, fnam, varname 88 !--- INPUT NETCDF FILES NAMES -------------------------------------------------- 89 CHARACTER(LEN=20) :: icefile, sstfile, dumstr, fnam 90 CHARACTER(LEN=10) :: varname 96 91 97 92 !--- OUTPUT VARIABLES FOR NETCDF FILE ------------------------------------------ 98 REAL :: fi_ice(klon) 93 REAL :: fi_ice(klon), verif(klon) 99 94 REAL, POINTER :: phy_rug(:,:)=>NULL(), phy_ice(:,:)=>NULL() 100 95 REAL, POINTER :: phy_sst(:,:)=>NULL(), phy_alb(:,:)=>NULL() … … 103 98 104 99 !--- VARIABLES FOR OUTPUT FILE WRITING ----------------------------------------- 105 INTEGER :: nid, ndim, ntim, k, dims(2), ix_sic, ix_sst100 INTEGER :: ierr, nid, ndim, ntim, k, dims(2), ix_sic, ix_sst 106 101 INTEGER :: id_tim, id_SST, id_BILS, id_RUG, id_ALB 107 102 INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC, varid_longitude, varid_latitude 108 103 INTEGER :: NF90_FORMAT 109 104 INTEGER :: ndays !--- Depending on the output calendar 110 CHARACTER(LEN= ns) :: str105 CHARACTER(LEN=256) :: str 111 106 112 107 !--- INITIALIZATIONS ----------------------------------------------------------- … … 341 336 ! Arguments: 342 337 CHARACTER(LEN=*), INTENT(IN) :: fnam ! NetCDF file name 343 CHARACTER(LEN= *),INTENT(IN) :: varname ! NetCDF variable name344 CHARACTER(LEN= *), INTENT(IN) :: mode ! RUG, SIC, SST or ALB338 CHARACTER(LEN=10), INTENT(IN) :: varname ! NetCDF variable name 339 CHARACTER(LEN=3), INTENT(IN) :: mode ! RUG, SIC, SST or ALB 345 340 INTEGER, INTENT(IN) :: ndays ! current year number of days 346 341 REAL, POINTER, DIMENSION(:, :) :: champo ! output field = f(t) … … 351 346 !--- NetCDF 352 347 INTEGER :: ncid, varid ! NetCDF identifiers 353 CHARACTER(LEN= ns) :: dnam ! dimension name348 CHARACTER(LEN=30) :: dnam ! dimension name 354 349 !--- dimensions 355 350 INTEGER :: dids(4) ! NetCDF dimensions identifiers … … 365 360 REAL, ALLOCATABLE :: champan(:,:,:) 366 361 !--- input files 367 CHARACTER(LEN=ns) :: fnam_m, fnam_p ! previous/next files names 368 CHARACTER(LEN=ns) :: cal_in ! calendar 369 CHARACTER(LEN=ns) :: units ! attribute "units" in sic/sst file 362 CHARACTER(LEN=20) :: fnam_m, fnam_p ! previous/next files names 363 CHARACTER(LEN=20) :: cal_in ! calendar 364 CHARACTER(LEN=20) :: unit_sic ! attribute "units" in sea-ice file 365 CHARACTER(LEN=20) :: unit_sst ! attribute "units" in sst file 370 366 INTEGER :: ndays_in ! number of days 371 REAL :: value ! mean/max value near equator372 367 !--- misc 373 INTEGER :: i, j, k, l 368 INTEGER :: i, j, k, l, ll ! loop counters 374 369 REAL, ALLOCATABLE :: work(:,:) ! used for extrapolation 375 CHARACTER(LEN= ns):: title, mess ! for messages370 CHARACTER(LEN=128):: title, mess ! for messages 376 371 LOGICAL :: is_bcs ! flag for BCS data 377 372 LOGICAL :: extrp ! flag for extrapolation 378 LOGICAL :: ll379 373 REAL :: chmin, chmax, timeday, al 380 374 INTEGER ierr, idx … … 401 395 CALL ncerr(NF90_INQ_VARID(ncid, trim(varname), varid),fnam) 402 396 CALL ncerr(NF90_INQUIRE_VARIABLE(ncid, varid, dimids=dids),fnam) 397 398 !--- Read unit for sea-ice and sst only 399 IF (mode=='SIC') THEN 400 ierr=NF90_GET_ATT(ncid, varid, 'units', unit_sic); CALL strclean(unit_sic) 401 IF(ierr/=NF90_NOERR) THEN; unit_sic='%' 402 CALL msg(0,'No unit in sea-ice file. Take percentage as default value') 403 ELSE IF(TRIM(unit_sic)=="%") THEN 404 CALL msg(0,'Sea-ice cover is a PERCENTAGE.') 405 ELSE IF(ANY(unit_sic==["1.0","1 "])) THEN; unit_sic="1" 406 CALL msg(0,'Sea-ice cover is a FRACTION.') 407 ELSE 408 CALL abort_physic('SIC','Unrecognized sea-ice unit: '//TRIM(unit_sic),1) 409 END IF 410 END IF 411 IF (mode=='SST') THEN 412 ierr=NF90_GET_ATT(ncid, varid, 'units', unit_sst); CALL strclean(unit_sst) 413 IF(ierr/=NF90_NOERR) THEN 414 CALL msg(0,'No unit in sst file. Take default: kelvins.') 415 unit_sst='X' 416 ELSE IF(ANY(unit_sst==["degC ","DegC "])) THEN; unit_sst='C' 417 CALL msg(0,'Sea-surface temperature is in CELCIUS DEGREES.') 418 ELSE IF(ANY(unit_sst==["K ","Kelvin"])) THEN; unit_sst='K' 419 CALL msg(0,'Sea-surface temperature is in KELVINS.') 420 ELSE 421 CALL abort_physic('SST','Unrecognized sst unit: '//TRIM(unit_sst),1) 422 END IF 423 END IF 403 424 404 425 !--- Longitude … … 456 477 DO l=1, lmdep 457 478 CALL ncerr(NF90_GET_VAR(ncid,varid,champ,[1,1,l],[imdep,jmdep,1]),fnam) 479 !--- Check whether values are acceptable for SIC, depending on unit. 480 !--- Dropped for mid-month boundary conditions datasets (BCS, ix_sic==1) 481 IF(mode=='SIC'.AND.ix_sic/=1) THEN 482 IF(TRIM(unit_sic)=="1".OR.TRIM(unit_sic)=="1.0") THEN 483 IF(ANY(champ>1.0+EPSFRA)) & 484 CALL abort_physic('SIC','Found sea-ice fractions greater than 1.') 485 ELSE IF(TRIM(unit_sic)=="%") THEN 486 IF(ANY(champ>100.0+EPSFRA)) & 487 CALL abort_physic('SIC','Found sea-ice percentages greater than 100.') 488 ! IF(MAXVAL(champ)< 1.01) & 489 ! CALL abort_physic('SIC','All sea-ice percentages lower than 1.') 490 END IF 491 END IF 458 492 CALL conf_dat2d(title, dlon_ini, dlat_ini, dlon, dlat, champ, .TRUE.) 459 460 !--- FOR SIC/SST FIELDS ONLY461 IF(l==1.AND.is_in(mode,['SIC','SST'])) THEN462 463 !--- DETERMINE THE UNIT: READ FROM FILE OR ASSUMED USING FIELD VALUES464 ierr=NF90_GET_ATT(ncid, varid, 'units', units)465 IF(ierr==NF90_NOERR) THEN !--- ATTRIBUTE "units" FOUND IN THE FILE466 CALL strclean(units)467 IF(mode=='SIC'.AND.is_in(units,Perc)) units="%"468 IF(mode=='SIC'.AND.is_in(units,Frac)) units="1"469 IF(mode=='SST'.AND.is_in(units,DegC)) units="C"470 IF(mode=='SST'.AND.is_in(units,DegK)) units="K"471 ELSE !--- CHECK THE FIELD VALUES472 IF(mode=='SIC') value=MAXVAL(champ(:,:))473 IF(mode=='SST') value= SUM(champ(:,jmdep/2),DIM=1)/REAL(imdep)474 IF(mode=='SIC') THEN; units="1"; IF(value>= 10.) units="%"; END IF475 IF(mode=='SST') THEN; units="C"; IF(value>=100.) units="K"; END IF476 END IF477 CALL msg(0,'INPUT FILE '//TRIM(title)//' UNIT IS: "'//TRIM(units)//'".')478 IF(ierr/=NF90_NOERR) CALL msg(0,'WARNING ! UNIT TO BE CHECKED ! ' &479 //'No "units" attribute, so only based on the fields values.')480 481 !--- CHECK VALUES ARE IN THE EXPECTED RANGE482 SELECT CASE(units)483 CASE('%'); ll=ANY(champ>100.0+EPSFRA); str='percentages > 100.'484 CASE('1'); ll=ANY(champ> 1.0+EPSFRA); str='fractions > 1.'485 CASE('C'); ll=ANY(champ<-100.).OR.ANY(champ> 60.); str='<-100 or >60 DegC'486 CASE('K'); ll=ANY(champ< 180.).OR.ANY(champ>330.); str='<180 or >330 DegK'487 CASE DEFAULT; CALL abort_physic(mode, 'Unrecognized '//TRIM(title) &488 //' unit: '//TRIM(units),1)489 END SELECT490 491 !--- DROPPED FOR BCS DATA (FRACTIONS CAN BE HIGHER THAN 1)492 IF(ll.AND.ix_sic/=1.AND.mode=='SIC') &493 CALL abort_physic(mode,'unrealistic '//TRIM(mode)//' found: '//TRIM(str))494 495 END IF496 497 493 IF(extrp) CALL extrapol(champ,imdep,jmdep,999999.,.TRUE.,.TRUE.,2,work) 498 494 IF(l==1) THEN 499 CALL msg(5,"-------------------------------------------------------- ")500 CALL msg(5,"$$$ Barycentri cinterpolation for "//TRIM(title)//" $$$")501 CALL msg(5,"-------------------------------------------------------- ")495 CALL msg(5,"----------------------------------------------------------") 496 CALL msg(5,"$$$ Barycentrique interpolation for "//TRIM(title)//" $$$") 497 CALL msg(5,"----------------------------------------------------------") 502 498 END IF 503 499 IF(mode=='RUG') champ=LOG(champ) … … 571 567 IF(.NOT.is_bcs) WRITE(lunout, *)'SPLINES TIME INTERPOLATION.' 572 568 WRITE(lunout, *)' Input time vector: ', timeyear 573 WRITE(lunout, *)' Output time vector : from 0.5 to ', ndays-0.5569 WRITE(lunout, *)' Output time vector from 0 to ', ndays-1 574 570 END IF 575 571 END IF … … 618 614 !--- SPECIAL FILTER FOR SST: SST>271.38 -------------------------------------- 619 615 IF(mode=='SST') THEN 620 SELECT CASE(units) 621 CASE("K"); CALL msg(0,'SST field is already in kelvins.') 622 CASE("C"); CALL msg(0,'SST field converted from celcius degrees to kelvins.') 623 champan(:, :, :)=champan(:, :, :)+273.15 624 END SELECT 625 CALL msg(0,'Filtering SST: Sea Surface Temperature >= 271.38') 616 IF(TRIM(unit_sst)=="K") THEN 617 ! Nothing to be done if the sst field is already in kelvins 618 CALL msg(0,'SST field is already in kelvins.') 619 ELSE 620 ! Convert sst field from celcius degrees to kelvins 621 CALL msg(0,'SST field converted from celcius degrees to kelvins.') 622 champan=champan+273.15 623 END IF 624 CALL msg(0,'Filtering SST: SST >= 271.38') 626 625 WHERE(champan<271.38) champan=271.38 627 626 END IF … … 629 628 !--- SPECIAL FILTER FOR SIC: 0.0<SIC<1.0 ------------------------------------- 630 629 IF(mode=='SIC') THEN 631 SELECT CASE(units) 632 CASE("1"); CALL msg(0,'SIC field already in fraction of 1') 633 CASE("%"); CALL msg(0,'SIC field converted from percentage to fraction of 1.') 630 CALL msg(0,'Filtering SIC: 0.0 < Sea-ice < 1.0') 631 IF(TRIM(unit_sic)=="1") THEN 632 ! Nothing to be done if the sea-ice field is already in fraction of 1 633 ! This is the case for sea-ice in file cpl_atm_sic.nc 634 CALL msg(0,'Sea-ice field already in fraction of 1') 635 ELSE 636 ! Convert sea ice from percentage to fraction of 1 637 CALL msg(0,'Sea-ice field converted from percentage to fraction of 1.') 634 638 champan(:, :, :)=champan(:, :, :)/100. 635 END SELECT636 CALL msg(0,'Filtering SIC: 0.0 <= Sea-ice <=1.0')639 END IF 640 champan(iip1, :, :)=champan(1, :, :) 637 641 WHERE(champan>1.0) champan=1.0 638 642 WHERE(champan<0.0) champan=0.0 … … 666 670 !------------------------------------------------------------------------------- 667 671 ! Local variables: 668 CHARACTER(LEN= ns):: modname="start_init_orog0"672 CHARACTER(LEN=256) :: modname="start_init_orog0" 669 673 INTEGER :: fid, llm_tmp,ttm_tmp, iml,jml, iml_rel,jml_rel, itau(1) 670 674 REAL :: lev(1), date, dt, deg2rad … … 785 789 !------------------------------------------------------------------------------- 786 790 787 788 !-------------------------------------------------------------------------------789 !790 FUNCTION is_in(s1,s2) RESULT(res)791 !792 !-------------------------------------------------------------------------------793 IMPLICIT NONE794 !-------------------------------------------------------------------------------795 ! Purpose: Check wether s1 is present in the s2(:) list (case insensitive).796 !-------------------------------------------------------------------------------797 ! Arguments:798 CHARACTER(LEN=*), INTENT(IN) :: s1, s2(:)799 LOGICAL :: res800 !-------------------------------------------------------------------------------801 res=.FALSE.; DO k=1,SIZE(s2); res=res.OR.strLow(s1)==strLow(s2(k)); END DO802 803 END FUNCTION is_in804 !805 !-------------------------------------------------------------------------------806 807 808 !-------------------------------------------------------------------------------809 !810 ELEMENTAL FUNCTION strLow(s) RESULT(res)811 !812 !-------------------------------------------------------------------------------813 IMPLICIT NONE814 !-------------------------------------------------------------------------------815 ! Purpose: Lower case conversion.816 !-------------------------------------------------------------------------------817 ! Arguments:818 CHARACTER(LEN=*), INTENT(IN) :: s819 CHARACTER(LEN=ns) :: res820 !-------------------------------------------------------------------------------821 ! Local variable:822 INTEGER :: k, ix823 !-------------------------------------------------------------------------------824 res=s825 DO k=1,LEN(s); ix=IACHAR(s(k:k))826 IF(64<ix.AND.ix<91) res(k:k)=ACHAR(ix+32)827 END DO828 829 END FUNCTION strLow830 !831 !-------------------------------------------------------------------------------832 833 791 #endif 834 792 ! of #ifndef CPP_1D
Note: See TracChangeset
for help on using the changeset viewer.