Ignore:
Timestamp:
Jul 22, 2024, 9:29:09 PM (4 months ago)
Author:
abarral
Message:

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line

Location:
LMDZ6/branches/Amaury_dev/tools
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/tools/fcm/doc/standards/fortran_standard.html

    r1578 r5099  
    10701070! Description:
    10711071!   <Explain the usage of the subroutine and what it does.>
    1072 !
     1072
    10731073! (c) Crown copyright Met Office. All rights reserved.
    10741074! For further details please refer to the file COPYRIGHT.txt

  • LMDZ6/branches/Amaury_dev/tools/make_sso/make_sso_SpherePack.f90

    r5088 r5099  
    11!-------------------------------------------------------------------------------
    2 !
     2
    33PROGRAM make_sso
    4 !
     4
    55!-------------------------------------------------------------------------------
    66! Purpose: Project ETOPO file (GMT4 axes conventions) on spherical harmonics.
    … …  
    117117    SELECT CASE(arg)
    118118      CASE('-i');   f_in=args(k); msg='Missing file "'//TRIM(f_in)//'".'
    119                     ll=NF90_OPEN(f_in,NF90_NOWRITE,fID)/=NF90_NOERR
     119                    ll=NF90_OPEN(f_in,NF90_NOWRITE,fID)/=nf90_noerr
    120120                    IF(.NOT.ll) n=NF90_CLOSE(fID)
    121121      CASE('-res'); nlon_ou=str2int(args(k)); k=k+1
    … …  
    135135  IF(ALL(['noro','spec']/=fmsk)) THEN
    136136    msg='Missing or wrong "-m" option ; can be "noro", "spec" or a mask file'
    137     CALL err(NF90_OPEN(fmsk,NF90_NOWRITE,fID)/=NF90_NOERR,msg)
     137    CALL err(NF90_OPEN(fmsk,NF90_NOWRITE,fID)/=nf90_noerr,msg)
    138138    CALL nc(NF90_INQ_VARID(fID,"MaskOcean",vID),"MaskOcean")    !--- MASK ID
    139139    CALL nc(NF90_INQUIRE_VARIABLE(fID,vID,dimids=dIDs))         !--- DIMS IDS
    140     CALL nc(NF90_INQUIRE_DIMENSION(fID,dIDs(1),len=nlon_ou),'x')!--- NB LONG
    141     CALL nc(NF90_INQUIRE_DIMENSION(fID,dIDs(2),len=nlat_ou),'y')!--- NB LAT
     140    CALL nc(nf90_inquire_dimension(fID,dIDs(1),len=nlon_ou),'x')!--- NB LONG
     141    CALL nc(nf90_inquire_dimension(fID,dIDs(2),len=nlat_ou),'y')!--- NB LAT
    142142    CALL nc(NF90_CLOSE(fID))
    143143  END IF
    … …  
    153153  CALL nc(NF90_INQ_VARID(fID,vnam,vID))
    154154  CALL nc(NF90_INQUIRE_VARIABLE (fID,vID,dimids=dIDs))
    155   CALL nc(NF90_INQUIRE_DIMENSION(fID,dIDs(1),len=nlon_in,name=lonn))
    156   CALL nc(NF90_INQUIRE_DIMENSION(fID,dIDs(2),len=nlat_in,name=latn))
     155  CALL nc(nf90_inquire_dimension(fID,dIDs(1),len=nlon_in,name=lonn))
     156  CALL nc(nf90_inquire_dimension(fID,dIDs(2),len=nlat_in,name=latn))
    157157  WRITE(*,*)TRIM(vnam)//' is '//TRIM(lonn)//'('//TRIM(int2str(nlon_in))//')*'   &
    158158                              //TRIM(latn)//'('//TRIM(int2str(nlat_in))//')'
    … …  
    161161  CALL nc(NF90_INQ_VARID(fID,lonn,loID)        ,lonn)
    162162  CALL nc(NF90_INQ_VARID(fID,latn,laID)        ,latn)
    163   CALL nc(NF90_GET_VAR  (fID,loID,lon_in)      ,lonn)
    164   CALL nc(NF90_GET_VAR  (fID,laID,lat_in)      ,latn)
     163  CALL nc(nf90_get_var  (fID,loID,lon_in)      ,lonn)
     164  CALL nc(nf90_get_var  (fID,laID,lat_in)      ,latn)
    165165  CALL nc(NF90_GET_ATT  (fID,loID,'units',lonu),lonn)
    166166  CALL nc(NF90_GET_ATT  (fID,laID,'units',latu),latn)
    167   CALL nc(NF90_GET_VAR  (fID,vID,h(:,:),[1,1],[nlon_in+1,nlat_in]),vnam)
     167  CALL nc(nf90_get_var  (fID,vID,h(:,:),[1,1],[nlon_in+1,nlat_in]),vnam)
    168168  CALL nc(NF90_CLOSE(fID))
    169169
    … …  
    368368      ALLOCATE(msko(nlon_ou,nlat_ou))
    369369      msg='Missing or wrong "-m" option ; can be "noro", "spec" or a mask file'
    370       CALL err(NF90_OPEN(fmsk,NF90_NOWRITE,fID)/=NF90_NOERR,msg)
     370      CALL err(NF90_OPEN(fmsk,NF90_NOWRITE,fID)/=nf90_noerr,msg)
    371371      CALL nc(NF90_INQ_VARID(fID,"MaskOcean",vID),"MaskOcean")    !--- MASK ID
    372       CALL nc(NF90_GET_VAR(fID,vID,msko(:,:)))                    !--- MASK
     372      CALL nc(nf90_get_var(fID,vID,msko(:,:)))                    !--- MASK
    373373      CALL nc(NF90_CLOSE(fID))
    374374      msko(:,:)=1.0-msko(:,:)
    … …  
    526526
    527527!-------------------------------------------------------------------------------
    528 !
     528
    529529SUBROUTINE diffusion_filter(a,b)
    530 !
     530
    531531!-------------------------------------------------------------------------------
    532532! Purpose: ECMWF bi-laplacian diffusion filter to limit aliasing.
    … …  
    557557
    558558END SUBROUTINE diffusion_filter
    559 !
    560 !-------------------------------------------------------------------------------
    561 
    562 
    563 !-------------------------------------------------------------------------------
    564 !
     559
     560!-------------------------------------------------------------------------------
     561
     562
     563!-------------------------------------------------------------------------------
     564
    565565SUBROUTINE lowpass_filter(a,b,d,dd)
    566 !
     566
    567567!-------------------------------------------------------------------------------
    568568! Purpose: ECMWF lowpass filter.
    … …  
    585585
    586586END SUBROUTINE lowpass_filter
    587 !
    588 !-------------------------------------------------------------------------------
    589 
    590 
    591 !-------------------------------------------------------------------------------
    592 !
     587
     588!-------------------------------------------------------------------------------
     589
     590
     591!-------------------------------------------------------------------------------
     592
    593593SUBROUTINE bandpass_filter(a,b,d1,dd1,d2,dd2)
    594 !
     594
    595595!-------------------------------------------------------------------------------
    596596! Purpose: ECMWF bandpass filter. Calls lowpass filter with 2 different scales.
    … …  
    616616
    617617END SUBROUTINE bandpass_filter
    618 !
    619 !-------------------------------------------------------------------------------
    620 
    621 
    622 !-------------------------------------------------------------------------------
    623 !
     618
     619!-------------------------------------------------------------------------------
     620
     621
     622!-------------------------------------------------------------------------------
     623
    624624SUBROUTINE lowpass(d,dd,h)
    625 !
     625
    626626!-------------------------------------------------------------------------------
    627627  IMPLICIT NONE
    … …  
    639639
    640640END SUBROUTINE lowpass
    641 !
    642 !-------------------------------------------------------------------------------
    643 
    644 
    645 !-------------------------------------------------------------------------------
    646 !
     641
     642!-------------------------------------------------------------------------------
     643
     644
     645!-------------------------------------------------------------------------------
     646
    647647SUBROUTINE spatial_filter_1(u,D,dd)
    648 !
     648
    649649!-------------------------------------------------------------------------------
    650650! Purpose: Spatial filter ; using spectral lowpass filter.
    … …  
    665665
    666666END SUBROUTINE spatial_filter_1
    667 !
    668 !-------------------------------------------------------------------------------
    669 
    670 
    671 !-------------------------------------------------------------------------------
    672 !
     667
     668!-------------------------------------------------------------------------------
     669
     670
     671!-------------------------------------------------------------------------------
     672
    673673SUBROUTINE spatial_filter_m(u,D,dd)
    674 !
     674
    675675!-------------------------------------------------------------------------------
    676676! Purpose: Spatial filter ; using spectral lowpass filter.
    … …  
    712712
    713713END SUBROUTINE spatial_filter_m
    714 !
    715 !-------------------------------------------------------------------------------
    716 
    717 
    718 !-------------------------------------------------------------------------------
    719 !
     714
     715!-------------------------------------------------------------------------------
     716
     717
     718!-------------------------------------------------------------------------------
     719
    720720SUBROUTINE grid_noro0(xin,yin,zin,xou,you,zphi,mask)
    721 !
     721
    722722!-------------------------------------------------------------------------------
    723723! Purpose: Sub-cell scales orographic parameters coomputation. Angles in radians
    … …  
    810810
    811811END SUBROUTINE grid_noro0
    812 !
    813 !-------------------------------------------------------------------------------
    814 
    815 
    816 !-------------------------------------------------------------------------------
    817 !
     812
     813!-------------------------------------------------------------------------------
     814
     815
     816!-------------------------------------------------------------------------------
     817
    818818SUBROUTINE nc(ncres,var)
    819 !
     819
    820820!-------------------------------------------------------------------------------
    821821! Purpose: NetCDF errors handling.
    … …  
    830830  CHARACTER(LEN=256) :: msg
    831831!-------------------------------------------------------------------------------
    832   IF(ncres/=NF90_NoErr) THEN
     832  IF(ncres/=nf90_noerr) THEN
    833833    msg='Error in routine '//TRIM(sub)
    834834    IF(fnam/='')     msg=TRIM(msg)//' for file "'//TRIM(fnam)//'"'
    … …  
    838838
    839839END SUBROUTINE nc
    840 !
    841 !-------------------------------------------------------------------------------
    842 
    843 
    844 !-------------------------------------------------------------------------------
    845 !
     840
     841!-------------------------------------------------------------------------------
     842
     843
     844!-------------------------------------------------------------------------------
     845
    846846ELEMENTAL FUNCTION int2str(val)
    847 !
     847
    848848!-------------------------------------------------------------------------------
    849849  IMPLICIT NONE
    … …  
    865865
    866866!-------------------------------------------------------------------------------
    867 !
     867
    868868SUBROUTINE err(ierr,str)
    869 !
     869
    870870!-------------------------------------------------------------------------------
    871871  IMPLICIT NONE
    … …  
    880880
    881881END SUBROUTINE err
    882 !
    883 !-------------------------------------------------------------------------------
    884 
    885 
    886 !-------------------------------------------------------------------------------
    887 !
     882
     883!-------------------------------------------------------------------------------
     884
     885
     886!-------------------------------------------------------------------------------
     887
    888888SUBROUTINE error(sub,ierr)
    889 !
     889
    890890!-------------------------------------------------------------------------------
    891891  IMPLICIT NONE
    … …  
    900900  STOP
    901901END SUBROUTINE error
    902 !
    903 !-------------------------------------------------------------------------------
    904 
    905 
    906 !-------------------------------------------------------------------------------
    907 !
     902
     903!-------------------------------------------------------------------------------
     904
     905
     906!-------------------------------------------------------------------------------
     907
    908908ELEMENTAL FUNCTION real2str(val)
    909 !
     909
    910910!-------------------------------------------------------------------------------
    911911  IMPLICIT NONE
    … …  
    927927
    928928!-------------------------------------------------------------------------------
    929 !
     929
    930930SUBROUTINE flip(a)
    931 !
     931
    932932!-------------------------------------------------------------------------------
    933933  IMPLICIT NONE
    … …  
    945945
    946946END SUBROUTINE flip
    947 !
     947
    948948!-------------------------------------------------------------------------------
    949949
    … …  
    10681068
    10691069!-------------------------------------------------------------------------------
    1070 !
     1070
    10711071ELEMENTAL CHARACTER(LEN=256) FUNCTION strLow(str) RESULT(out)
    1072 !
     1072
    10731073!-------------------------------------------------------------------------------
    10741074  IMPLICIT NONE
    … …  
    10881088
    10891089END FUNCTION strLow
    1090 !
     1090
    10911091!-------------------------------------------------------------------------------
    10921092
    10931093END PROGRAM make_sso
    1094 !
    1095 !-------------------------------------------------------------------------------
     1094
     1095!-------------------------------------------------------------------------------

  • LMDZ6/branches/Amaury_dev/tools/netcdf95/Datasets/nf95_find_coord.f90

    r5088 r5099  
    1515    ! attribute "std_name".
    1616
    17     use netcdf, only: NF90_MAX_NAME, NF90_NOERR
     17    use netcdf, only: NF90_MAX_NAME, nf90_noerr
    1818    use nf95_get_att_m, only: nf95_get_att
    1919    use nf95_inq_varid_m, only: nf95_inq_varid
    … …  
    8080       call nf95_inquire_dimension(ncid, dimid_local, name_local)
    8181       call nf95_inq_varid(ncid, name_local, varid_local, ncerr)
    82        if (ncerr == NF90_NOERR) then
     82       if (ncerr == nf90_noerr) then
    8383          call nf95_inquire_variable(ncid, varid_local, dimids=dimids)
    8484          if (size(dimids) == 1) then
    … …  
    8686                ! We have found a coordinate
    8787                call nf95_get_att(ncid, varid_local, "units", values, ncerr)
    88                 if (ncerr == NF90_NOERR)then
     88                if (ncerr == nf90_noerr)then
    8989                   if (exact) then
    9090                      found = any(values == units)

  • LMDZ6/branches/Amaury_dev/tools/netcdf95/Variables/nf95_get_var.f90

    r5088 r5099  
    11module nf95_get_var_m
    22
    3   use netcdf, only: nf90_get_var, NF90_NOERR
     3  use netcdf, only: nf90_get_var, nf90_noerr
    44 
    55  use nf95_abort_m, only: nf95_abort

  • LMDZ6/branches/Amaury_dev/tools/netcdf95/Variables/nf95_get_var_array.h

    r4918 r5099  
    1616  end if
    1717
    18   if (ncerr_not_opt == NF90_NOERR .and. present(new_missing)) then
     18  if (ncerr_not_opt == nf90_noerr .and. present(new_missing)) then
    1919     call nf95_get_missing(ncid, varid, missing)
    2020     where (values == missing) values = new_missing

  • LMDZ6/branches/Amaury_dev/tools/netcdf95/Variables/nf95_get_var_scalar.h

    r4918 r5099  
    1414  end if
    1515
    16   if (ncerr_not_opt == NF90_NOERR .and. present(new_missing)) then
     16  if (ncerr_not_opt == nf90_noerr .and. present(new_missing)) then
    1717     call nf95_get_missing(ncid, varid, missing)
    1818     if (values == missing) values = new_missing
Note: See TracChangeset for help on using the changeset viewer.