Ignore:
Timestamp:
Jul 23, 2024, 3:29:36 PM (4 months ago)
Author:
abarral
Message:

Handle CPP_INLANDSIS in lmdz_cppkeys_wrapper.F90
Remove obsolete key wrgrads_thermcell, _ADV_HALO, _ADV_HALLO, isminmax
Remove redundant uses of CPPKEY_INCA (thanks acozic)
Remove obsolete misc/write_field.F90
Remove unused ioipsl_* wrappers
Remove calls to WriteField_u with wrong signature
Convert .F -> .[fF]90
(lint) uppercase fortran operators
[note: 1d and iso still broken - working on it]

Location:
LMDZ6/branches/Amaury_dev/libf/misc
Files:
3 deleted
16 edited
1 copied

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/misc/formcoord.F

    r5099 r5103  
    22! $Header$
    33
    4       subroutine formcoord(unit,n,x,a,rev,text)
     4      SUBROUTINE formcoord(unit,n,x,a,rev,text)
    55      implicit none
    66      integer n,unit,ndec

  • LMDZ6/branches/Amaury_dev/libf/misc/interpolation.F90

    r5086 r5103  
    8787       inc=1 ! Set the hunting increment.
    8888       if (jlo == 0) then
    89           hunt_up = .true.
     89          hunt_up = .TRUE.
    9090       else
    9191          hunt_up = x >= xx(jlo) .eqv. ascnd

  • LMDZ6/branches/Amaury_dev/libf/misc/juldate.F

    r5099 r5103  
    22! $Id$
    33
    4         subroutine juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec)
     4        SUBROUTINE juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec)
    55c       Sous-routine de changement de date:
    66c       gregorien>>>date julienne

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_TO_MOVE_ssum_scopy.f90

    r5098 r5103  
    33! Those are old legacy CRAY replacement functions, that are now used in several parts of the code.
    44
    5 subroutine scopy(n, sx, incx, sy, incy)
     5SUBROUTINE scopy(n, sx, incx, sy, incy)
    66
    77  IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_cppkeys_wrapper.F90

    r5102 r5103  
    77!      NC_DOUBLE      -> nf90_format
    88!      CPP_PHYS       -> CPPKEY_PHYS
    9 !      INCA           -> CPPKEY_INCA
     9!      INCA           -> CPPKEY_INCA   ! -> also in lmdz_inca_wrappers.F90
    1010!      CPP_StratAer   -> CPPKEY_STRATAER
    1111!      CPP_DUST       -> CPPKEY_DUST
    1212!      CPP_INLANDSIS  -> CPPKEY_INLANDSIS
     13!      OUTPUT_PHYS_SCM-> CPPKEY_OUTPUTPHYSSCM
    1314! ---------------------------------------------
    1415
    … …  
    6263#endif
    6364
     65#ifdef OUTPUT_PHYS_SCM
     66  LOGICAL, PARAMETER :: CPPKEY_OUTPUTPHYSSCM = .TRUE.
     67#else
     68  LOGICAL, PARAMETER :: CPPKEY_OUTPUTPHYSSCM = .FALSE.
     69#endif
     70
    6471END MODULE lmdz_cppkeys_wrapper

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_inca_wrappers.F90

    r5101 r5103  
    1 ! mpi subroutine wrappers
    2 
    3 #ifndef CPP_MPI
    4 
    5 SUBROUTINE lmdz_mpi_wrapper_abort
    6   STOP 'CPP_MPI key undefined, must not enter in MPI wrappers ==> aborting'
    7 END SUBROUTINE lmdz_mpi_wrapper_abort
    8 
    9 SUBROUTINE MPI_ABORT(COMM, ERRORCODE, IERROR)
    10 IMPLICIT NONE
    11     INTEGER ::       COMM, ERRORCODE, IERROR
    12     CALL lmdz_mpi_wrapper_abort
    13 END SUBROUTINE MPI_ABORT
    14 
    15 SUBROUTINE MPI_ALLGATHER(SENDBUF, SENDCOUNT, SENDTYPE, RECVBUF, RECVCOUNT, RECVTYPE, COMM, IERROR)
    16 USE ISO_C_BINDING
    17 IMPLICIT NONE
    18     TYPE(C_PTR),VALUE  ::   SENDBUF , RECVBUF
    19     INTEGER    SENDCOUNT, SENDTYPE, RECVCOUNT, RECVTYPE, COMM
    20     INTEGER    IERROR
    21     CALL lmdz_mpi_wrapper_abort
    22 END SUBROUTINE   MPI_ALLGATHER
    23  
    24 SUBROUTINE MPI_COMM_SIZE(COMM, SIZE, IERROR)
    25 IMPLICIT NONE
    26     INTEGER    COMM, SIZE, IERROR
    27     CALL lmdz_mpi_wrapper_abort
    28 END SUBROUTINE MPI_COMM_SIZE
    29 
    30 SUBROUTINE MPI_COMM_RANK(COMM, RANK, IERROR)
    31 IMPLICIT NONE
    32     INTEGER    COMM, RANK, IERROR
    33     CALL lmdz_mpi_wrapper_abort
    34 END SUBROUTINE MPI_COMM_RANK
    35 
    36 SUBROUTINE MPI_BARRIER(COMM, IERROR)
    37 IMPLICIT NONE
    38     INTEGER    COMM, IERROR
    39     CALL lmdz_mpi_wrapper_abort
    40 END SUBROUTINE MPI_BARRIER   
    41 
    42 SUBROUTINE MPI_ISEND(BUF, COUNT, DATATYPE, DEST, TAG, COMM, REQUEST, IERROR)
    43 USE ISO_C_BINDING
    44 IMPLICIT NONE
    45     TYPE(C_PTR),VALUE  ::    BUF
    46     INTEGER    COUNT, DATATYPE, DEST, TAG, COMM, REQUEST, IERROR
    47    
    48     CALL lmdz_mpi_wrapper_abort
    49 END SUBROUTINE MPI_ISEND
    50 
    51 SUBROUTINE MPI_ISSEND(BUF, COUNT, DATATYPE, DEST, TAG, COMM, REQUEST, IERROR)
    52 USE ISO_C_BINDING
    53 IMPLICIT NONE
    54     TYPE(C_PTR),VALUE  ::    BUF
    55     INTEGER    COUNT, DATATYPE, DEST, TAG, COMM, REQUEST, IERROR
    56     CALL lmdz_mpi_wrapper_abort
    57 END SUBROUTINE MPI_ISSEND
    58 
    59 SUBROUTINE MPI_IRECV(BUF, COUNT, DATATYPE, SOURCE, TAG, COMM, REQUEST, IERROR)
    60 USE ISO_C_BINDING
    61 IMPLICIT NONE
    62     TYPE(C_PTR),VALUE  ::    BUF
    63     INTEGER    COUNT, DATATYPE, SOURCE, TAG, COMM, REQUEST, IERROR
    64     CALL lmdz_mpi_wrapper_abort
    65 END SUBROUTINE MPI_IRECV   
    66 
    67 SUBROUTINE MPI_WAITALL(COUNT, ARRAY_OF_REQUESTS, ARRAY_OF_STATUSES, IERROR)
    68 USE lmdz_mpi, ONLY: MPI_STATUS_SIZE
    69 IMPLICIT NONE
    70     INTEGER    COUNT, ARRAY_OF_REQUESTS(*)
    71     INTEGER    ARRAY_OF_STATUSES(MPI_STATUS_SIZE,*), IERROR
    72     CALL lmdz_mpi_wrapper_abort
    73 END SUBROUTINE  MPI_WAITALL 
    74 
    75 SUBROUTINE MPI_GATHERV(SENDBUF, SENDCOUNT, SENDTYPE, RECVBUF, RECVCOUNTS, DISPLS, RECVTYPE, ROOT, COMM, IERROR)
    76 USE ISO_C_BINDING
    77 IMPLICIT NONE
    78     TYPE(C_PTR),VALUE  ::    SENDBUF, RECVBUF
    79     INTEGER    SENDCOUNT, SENDTYPE, RECVCOUNTS(*), DISPLS(*)
    80     INTEGER    RECVTYPE, ROOT, COMM, IERROR
    81     CALL lmdz_mpi_wrapper_abort
    82 END SUBROUTINE MPI_GATHERV
    83    
    84 SUBROUTINE MPI_BCAST(BUFFER, COUNT, DATATYPE, ROOT, COMM, IERROR)
    85 USE ISO_C_BINDING
    86 IMPLICIT NONE
    87     TYPE(C_PTR),VALUE  ::    BUFFER
    88     INTEGER    COUNT, DATATYPE, ROOT, COMM, IERROR
    89     CALL lmdz_mpi_wrapper_abort
    90 END SUBROUTINE MPI_BCAST
    91 
    92 SUBROUTINE MPI_ALLREDUCE(SENDBUF, RECVBUF, COUNT, DATATYPE, OP, COMM, IERROR)
    93 USE ISO_C_BINDING
    94 IMPLICIT NONE
    95     TYPE(C_PTR),VALUE  ::    SENDBUF, RECVBUF
    96     INTEGER    COUNT, DATATYPE, OP, COMM, IERROR
    97     CALL lmdz_mpi_wrapper_abort
    98 END SUBROUTINE MPI_ALLREDUCE
    99 
    100 SUBROUTINE MPI_INIT_THREAD(REQUIRED, PROVIDED, IERROR)
    101 IMPLICIT NONE
    102     INTEGER    REQUIRED, PROVIDED, IERROR
    103     CALL lmdz_mpi_wrapper_abort
    104 END SUBROUTINE MPI_INIT_THREAD
    105 
    106 SUBROUTINE MPI_ALLOC_MEM(SIZE, INFO, BASEPTR, IERROR)
    107 USE lmdz_mpi, ONLY: MPI_ADDRESS_KIND
    108 IMPLICIT NONE
    109     INTEGER INFO, IERROR
    110     INTEGER(KIND=MPI_ADDRESS_KIND) SIZE, BASEPTR
    111     CALL lmdz_mpi_wrapper_abort
    112 END SUBROUTINE MPI_ALLOC_MEM
    113 
    114 SUBROUTINE MPI_SCATTERV(SENDBUF, SENDCOUNTS, DISPLS, SENDTYPE, RECVBUF, RECVCOUNT, RECVTYPE, ROOT, COMM, IERROR)
    115 USE ISO_C_BINDING
    116 IMPLICIT NONE
    117     TYPE(C_PTR),VALUE  ::    SENDBUF, RECVBUF
    118     INTEGER    SENDCOUNTS(*), DISPLS(*), SENDTYPE
    119     INTEGER    RECVCOUNT, RECVTYPE, ROOT, COMM, IERROR
    120     CALL lmdz_mpi_wrapper_abort
    121 END SUBROUTINE MPI_SCATTERV
    122 
    123 SUBROUTINE MPI_REDUCE(SENDBUF, RECVBUF, COUNT, DATATYPE, OP, ROOT, COMM, IERROR)
    124 USE ISO_C_BINDING
    125 IMPLICIT NONE
    126     TYPE(C_PTR),VALUE ::    SENDBUF, RECVBUF
    127     INTEGER    COUNT, DATATYPE, OP, ROOT, COMM, IERROR
    128     CALL lmdz_mpi_wrapper_abort
    129 END SUBROUTINE MPI_REDUCE
    130 
    131 SUBROUTINE MPI_RECV(BUF, COUNT, DATATYPE, SOURCE, TAG, COMM, STATUS, IERROR)
    132 USE ISO_C_BINDING
    133 USE lmdz_mpi, ONLY: MPI_STATUS_SIZE
    134 IMPLICIT NONE
    135     TYPE(C_PTR),VALUE ::    BUF
    136     INTEGER    COUNT, DATATYPE, SOURCE, TAG, COMM
    137     INTEGER    STATUS(MPI_STATUS_SIZE), IERROR
    138     CALL lmdz_mpi_wrapper_abort
    139 END SUBROUTINE MPI_RECV
    140 
    141 SUBROUTINE MPI_SEND(BUF, COUNT, DATATYPE, DEST, TAG, COMM, IERROR)
    142 USE ISO_C_BINDING
    143 IMPLICIT NONE
    144     TYPE(C_PTR),VALUE  ::  BUF
    145     INTEGER    COUNT, DATATYPE, DEST, TAG, COMM, IERROR
    146     CALL lmdz_mpi_wrapper_abort
    147 END SUBROUTINE MPI_SEND
    148 
    149 SUBROUTINE MPI_COMM_SPLIT(COMM, COLOR, KEY, NEWCOMM, IERROR)
    150 IMPLICIT NONE
    151     INTEGER    COMM, COLOR, KEY, NEWCOMM, IERROR
    152     CALL lmdz_mpi_wrapper_abort
    153 END SUBROUTINE MPI_COMM_SPLIT
    154 
    155 
    156 SUBROUTINE MPI_GATHER(SENDBUF, SENDCOUNT, SENDTYPE, RECVBUF, RECVCOUNT, RECVTYPE, ROOT, COMM, IERROR)
    157 USE ISO_C_BINDING
    158 IMPLICIT NONE
    159     TYPE(C_PTR),VALUE  ::  SENDBUF, RECVBUF
    160     INTEGER    SENDCOUNT, SENDTYPE, RECVCOUNT, RECVTYPE, ROOT
    161     INTEGER    COMM, IERROR
    162     CALL lmdz_mpi_wrapper_abort
    163 END SUBROUTINE MPI_GATHER
    164 
    165 
    166 SUBROUTINE MPI_FINALIZE(IERROR)
    167 IMPLICIT NONE
    168     INTEGER    IERROR
    169     CALL lmdz_mpi_wrapper_abort
    170 END SUBROUTINE MPI_Finalize
     1! inca SUBROUTINE wrappers
     2
     3#ifndef INCA
     4
     5SUBROUTINE lmdz_inca_wrapper_abort
     6  STOP 'INCA key undefined, must not enter in INCA wrappers ==> aborting'
     7END SUBROUTINE lmdz_inca_wrapper_abort
     8
     9SUBROUTINE Init_chem_inca_trac(NBTR)
     10  IMPLICIT NONE
     11  INTEGER, INTENT(out) :: nbtr
     12
     13  CALL lmdz_inca_wrapper_abort
     14END SUBROUTINE Init_chem_inca_trac
     15
     16SUBROUTINE init_transport(&
     17        tracnam_lmdz, &
     18        conv_flg_lmdz, &
     19        pbl_flg_lmdz, &
     20        hadv_flg_lmdz, &
     21        vadv_flg_lmdz)
     22  IMPLICIT NONE
     23  INTEGER, DIMENSION(:), INTENT(out) :: hadv_flg_lmdz
     24  INTEGER, DIMENSION(:), INTENT(out) :: vadv_flg_lmdz
     25
     26  INTEGER, DIMENSION(:), INTENT(out) :: conv_flg_lmdz
     27  INTEGER, DIMENSION(:), INTENT(out) :: pbl_flg_lmdz
     28  CHARACTER(len = 8), DIMENSION(:), INTENT(out) :: tracnam_lmdz
     29
     30  CALL lmdz_inca_wrapper_abort
     31END SUBROUTINE init_transport
     32
     33SUBROUTINE finalize_inca
     34  IMPLICIT NONE
     35  CALL lmdz_inca_wrapper_abort
     36END SUBROUTINE finalize_inca
     37
     38SUBROUTINE CHEMHOOK_BEGIN(&
     39        calday, &
     40        ijour, &
     41        gmtime, &
     42        oro, &
     43        lat, &
     44        lon, &
     45        area, &
     46        pfull, &
     47        pmid, &
     48        coefh, &
     49        zma, &
     50        temp, &
     51        u, &
     52        v, &
     53        rot, &
     54        ozrad, &
     55        sh, &
     56        ts, &
     57        t_air_2m, &
     58        dpth_snow, &
     59        sws, &
     60        albs, &
     61        rain_fall, &
     62        snow_fall, &
     63        ctop, &
     64        cbot, &
     65        cldfr, &
     66        nx, &
     67        ny, &
     68        mmr, &
     69        ftsol, &
     70        paprs, &
     71        cdragh, &
     72        cdragm, &
     73        pctsrf, &
     74        delt, &
     75        nstep)
     76  IMPLICIT NONE
     77  REAL, INTENT(IN) :: calday
     78  INTEGER, INTENT(in) :: ijour  ! jour julien
     79  REAL, INTENT(in) :: gmtime ! input-R-temps universel dans la journee (0 a 86400 s)
     80  INTEGER, INTENT(IN) :: ctop(:)
     81  INTEGER, INTENT(IN) :: cbot(:)
     82  INTEGER, INTENT(IN) :: nx, ny
     83  REAL, INTENT(IN) :: pmid(:, :)
     84  REAL, INTENT(IN) :: pfull(:, :)
     85  REAL, INTENT(IN) :: coefh(:, :)
     86  REAL, INTENT(IN) :: zma(:, :)
     87  REAL, INTENT(IN) :: temp(:, :)
     88  REAL, INTENT(IN) :: u(:, :)
     89  REAL, INTENT(IN) :: v(:, :)
     90  REAL, INTENT(IN) :: rot(:, :)
     91  REAL, INTENT(IN) :: ozrad(:, :)
     92  REAL, INTENT(IN) :: sh(:, :)
     93  REAL, INTENT(IN) :: lat(:)
     94  REAL, INTENT(IN) :: lon(:)
     95  REAL, INTENT(IN) :: oro(:)
     96  REAL, INTENT(IN) :: area(:)
     97  REAL, INTENT(IN) :: ts(:)
     98  REAL, INTENT(IN) :: t_air_2m(:) ! air temperature near surface
     99  REAL, INTENT(IN) :: dpth_snow(:)
     100  REAL, INTENT(IN) :: sws(:)
     101  REAL, INTENT(IN) :: albs(:)
     102  REAL, INTENT(IN) :: rain_fall(:)
     103  REAL, INTENT(IN) :: snow_fall(:)
     104  REAL, INTENT(IN) :: mmr(:, :, :)
     105  REAL, INTENT(IN) :: cldfr (:, :)
     106  ! variables used in nightingale
     107  REAL, INTENT(in) :: ftsol(:, :)
     108  REAL, INTENT(in) :: paprs(:, :)
     109  REAL, INTENT(in) :: cdragh(:), cdragm(:)
     110  REAL, INTENT(in) :: pctsrf(:, :)
     111  REAL, INTENT(in) :: delt               ! timestep in seconds of physics
     112  INTEGER, INTENT(IN) :: nstep              ! model time step
     113
     114  CALL lmdz_inca_wrapper_abort
     115END SUBROUTINE CHEMHOOK_BEGIN
     116
     117SUBROUTINE CHEMHOOK_END(&
     118        dt, &
     119        pmid, &
     120        temp, &
     121        mmr, &
     122        nbtr, &
     123        paprs, &
     124        sh, &
     125        area, &
     126        zma, &
     127        phis, &
     128        rh, aps, bps, ap, bp, lafin)
     129  IMPLICIT NONE
     130  INTEGER, INTENT(IN) :: nbtr
     131  REAL, INTENT(IN) :: dt
     132  REAL, INTENT(IN) :: pmid(:, :)
     133  REAL, INTENT(IN) :: area(:)
     134  REAL, INTENT(IN) :: temp(:, :)
     135  REAL, INTENT(IN) :: paprs(:, :)
     136  REAL, INTENT(IN) :: sh(:, :)
     137  REAL, INTENT(INOUT) :: mmr(:, :, :)
     138  REAL, INTENT(IN) :: zma(:, :)
     139  REAL, INTENT(IN) :: phis(:)
     140  REAL, INTENT(IN) :: rh(:, :)
     141  REAL, INTENT(IN), DIMENSION(:) :: aps, bps
     142  REAL, INTENT(IN), DIMENSION(:) :: ap, bp
     143  LOGICAL, INTENT(IN) :: lafin
     144
     145  CALL lmdz_inca_wrapper_abort
     146END SUBROUTINE chemhook_end
     147
     148SUBROUTINE chemtime(istp, date0, dt, itap)
     149  IMPLICIT NONE
     150  INTEGER, INTENT(in) :: istp   ! time step of the restart file
     151  REAL, INTENT(in) :: date0  ! the date at which itau = 0
     152  REAL, INTENT(in) :: dt     ! time step
     153  INTEGER, INTENT(in) :: itap
     154  CALL lmdz_inca_wrapper_abort
     155END SUBROUTINE chemtime
     156
     157SUBROUTINE INIT_CONST_LMDZ(&
     158        nday_l, &
     159        nbsrf_l, &
     160        is_oce_l, &
     161        is_sic_l, &
     162        is_ter_l, &
     163        is_lic_l, &
     164        calend_l, &
     165        config_inca_l)
     166  IMPLICIT NONE
     167  INTEGER, INTENT(in) :: nday_l
     168  INTEGER, INTENT(in) :: nbsrf_l
     169  INTEGER, INTENT(in) :: is_oce_l, is_sic_l, is_lic_l, is_ter_l
     170  CHARACTER (len = 10), INTENT(in) :: calend_l
     171  CHARACTER(len = 4), INTENT(in) :: config_inca_l
     172
     173  CALL lmdz_inca_wrapper_abort
     174END SUBROUTINE init_const_lmdz
     175
     176SUBROUTINE init_inca_geometry(&
     177        longitude_lmdz, latitude_lmdz, &
     178        boundslon_lmdz, boundslat_lmdz, &
     179        cell_area_lmdz, &
     180        ind_cell_glo_lmdz)
     181  IMPLICIT NONE
     182  REAL, INTENT(IN) :: longitude_lmdz(:)
     183  REAL, INTENT(IN) :: latitude_lmdz(:)
     184  REAL, INTENT(IN) :: boundslon_lmdz(:, :)
     185  REAL, INTENT(IN) :: boundslat_lmdz(:, :)
     186  REAL, INTENT(IN) :: cell_area_lmdz(:)
     187  INTEGER, OPTIONAL, INTENT(IN) :: ind_cell_glo_lmdz(:)
     188
     189  CALL lmdz_inca_wrapper_abort
     190END SUBROUTINE init_inca_geometry
     191
     192SUBROUTINE CHEMINI(pmid, &
     193        nbp_lon_lmdz, nbp_lat_lmdz, &
     194        latgcm, &
     195        longcm, &
     196        presnivs, &
     197        calday, &
     198        klon, &
     199        nqmax, &
     200        nqo, &
     201        pdtphys, &
     202        annee_ref, &
     203        year_cur, &
     204        day_ref, &
     205        day_ini, &
     206        start_time, &
     207        itau_phy, &
     208        date0, &
     209        chemistry_couple, &
     210        init_source, &
     211        init_tauinca, &
     212        init_pizinca, &
     213        init_cginca, &
     214        init_ccm, &
     215        io_lon, &
     216        io_lat)
     217  IMPLICIT NONE
     218  REAL, INTENT(IN) :: pmid(:, :)
     219  INTEGER, INTENT(in) :: nbp_lon_lmdz, nbp_lat_lmdz
     220  REAL, INTENT(in) :: calday
     221  REAL, INTENT(in) :: latgcm(:)
     222  REAL, INTENT(in) :: longcm(:)
     223  REAL, INTENT(in) :: presnivs(:)
     224  INTEGER, INTENT(in) :: klon
     225  INTEGER, INTENT(in) :: nqmax  ! nombre total de traceurs = inca + lmdz
     226  INTEGER, INTENT(in) :: nqo ! nombre de traceurs lus dans traceur.def
     227  REAL, INTENT(in) :: pdtphys
     228  INTEGER, INTENT(in) :: annee_ref, year_cur
     229  INTEGER, INTENT(in) :: day_ref, day_ini
     230  REAL, INTENT(in) :: start_time
     231  INTEGER, INTENT(in) :: itau_phy
     232  REAL, OPTIONAL, INTENT(IN) :: io_lat(nbp_lat_lmdz) ! latitudes (of global grid)
     233  REAL, OPTIONAL, INTENT(IN) :: io_lon(nbp_lon_lmdz) ! longitudes (of global grid)
     234  REAL, INTENT(IN) :: date0
     235  LOGICAL, INTENT(IN) :: chemistry_couple
     236  REAL, DIMENSION(:, :), INTENT(OUT) :: init_source
     237  REAL, DIMENSION(:, :, :, :), INTENT(OUT) :: init_tauinca
     238  REAL, DIMENSION(:, :, :, :), INTENT(OUT) :: init_pizinca
     239  REAL, DIMENSION(:, :, :, :), INTENT(OUT) :: init_cginca
     240  REAL, DIMENSION(:, :, :), INTENT(OUT) :: init_ccm
     241
     242  CALL lmdz_inca_wrapper_abort
     243END SUBROUTINE chemini
     244
     245SUBROUTINE radlwsw_inca(chemistry_couple, kdlon, kflev, dist, rmu0, fract, &
     246        solaire, paprs, pplay, tsol, albedo, alblw, t, q, size_wo, wo, &
     247        cldfra, cldemi, cldtaupd, &
     248        heat, heat0, cool, cool0, albpla, &
     249        topsw, toplw, solsw, sollw, &
     250        sollwdown, &
     251        topsw0, toplw0, solsw0, sollw0, &
     252        lwdn0, lwdn, lwup0, lwup, &
     253        swdn0, swdn, swup0, swup, &
     254        ok_ade, ok_aie, &
     255        tau_inca, piz_inca, cg_inca, &
     256        topswad_inca, solswad_inca, &
     257        topswad0_inca, solswad0_inca, &
     258        topsw_inca, topsw0_inca, &
     259        solsw_inca, solsw0_inca, &
     260        cldtaupi, topswai_inca, solswai_inca)
     261  IMPLICIT NONE
     262  LOGICAL, INTENT(in) :: chemistry_couple
     263  INTEGER, INTENT(in) :: kdlon, kflev
     264  REAL, INTENT(in) :: solaire
     265  REAL, INTENT(in) :: dist
     266  REAL, INTENT(in) :: rmu0(:), fract(:)
     267  REAL, INTENT(in) :: paprs(:, :), pplay(:, :)
     268  REAL, INTENT(in) :: albedo(:), alblw(:), tsol(:)
     269  REAL, INTENT(in) :: t(:, :), q(:, :)
     270  INTEGER, INTENT(in) :: size_wo
     271  REAL, INTENT(in) :: wo(:, :, :)  ! column-density of ozone in a layer, in kilo-Dobsons
     272  LOGICAL, INTENT(in) :: ok_ade, ok_aie     ! switches whether to use aerosol direct (indirect) effects or not
     273  REAL, INTENT(in) :: cldfra(:, :), cldemi(:, :), cldtaupd(:, :)
     274  REAL, INTENT(in) :: tau_inca(:, :, :, :) ! aerosol optical properties (see aeropt.F)
     275  REAL, INTENT(in) :: piz_inca(:, :, :, :) ! aerosol optical properties (see aeropt.F)
     276  REAL, INTENT(in) :: cg_inca(:, :, :, :)        ! aerosol optical properties (see aeropt.F)
     277  REAL, INTENT(in) :: cldtaupi(:, :)  ! cloud optical thickness for pre-industrial aerosol concentrations
     278  REAL, INTENT(out) :: heat(:, :), cool(:, :)
     279  REAL, INTENT(out) :: heat0(:, :), cool0(:, :)
     280  REAL, INTENT(out) :: topsw(:), toplw(:)
     281  REAL, INTENT(out) :: solsw(:), sollw(:), albpla(:)
     282  REAL, INTENT(out) :: topsw0(:), toplw0(:), solsw0(:), sollw0(:)
     283  REAL, INTENT(out) :: sollwdown(:)
     284  REAL, INTENT(out) :: swdn(:, :), swdn0(:, :)
     285  REAL, INTENT(out) :: swup(:, :), swup0(:, :)
     286  REAL, INTENT(out) :: lwdn(:, :), lwdn0(:, :)
     287  REAL, INTENT(out) :: lwup(:, :), lwup0(:, :)
     288  REAL, INTENT(out) :: topswad_inca(:), solswad_inca(:) ! output: aerosol direct forcing at TOA and surface
     289  REAL, INTENT(out) :: topswad0_inca(:), solswad0_inca(:) ! output: aerosol direct forcing at TOA and surface
     290  REAL, INTENT(out) :: topswai_inca(:), solswai_inca(:) ! output: aerosol indirect forcing atTOA and surface
     291  REAL(kind = 8), INTENT(out) :: topsw_inca(:, :), topsw0_inca(:, :)
     292  REAL(kind = 8), INTENT(out) :: solsw_inca(:, :), solsw0_inca(:, :)
     293
     294  CALL lmdz_inca_wrapper_abort
     295END SUBROUTINE radlwsw_inca
     296
     297SUBROUTINE INIT_INCA_DIM_REG(&
     298        iim, &
     299        jjm, &
     300        rlonu_l, &
     301        rlatu_l, &
     302        rlonv_l, &
     303        rlatv_l)
     304
     305  IMPLICIT NONE
     306  INTEGER, INTENT(in) :: iim
     307  INTEGER, INTENT(in) :: jjm
     308  REAL, INTENT(in) :: rlonu_l(:)
     309  REAL, INTENT(in) :: rlatu_l(:)
     310  REAL, INTENT(in) :: rlonv_l(:)
     311  REAL, INTENT(in) :: rlatv_l(:)
     312
     313  CALL lmdz_inca_wrapper_abort
     314END SUBROUTINE INIT_INCA_DIM_REG
     315
     316SUBROUTINE AEROSOL_METEO_CALC (&
     317        calday, delt, pmid, pfull, t_seri, &
     318        flxrcv, flxscv, flxrst, flxsst, pctsrf, &
     319        area, rlat, rlon, u10m, v10m)
     320  IMPLICIT NONE
     321  REAL, INTENT(in) :: calday
     322  REAL, INTENT(in) :: delt                ! [s]
     323  REAL, INTENT(in) :: pmid(:, :)     ! [Pa]
     324  REAL, INTENT(in) :: pfull(:, :)  ! [Pa]
     325  REAL, INTENT(in) :: t_seri(:, :)   ! [K]
     326  REAL, INTENT(in) :: flxrst(:, :) ! liquid water flux (stratiform) kgH2O/m2/s
     327  REAL, INTENT(in) :: flxrcv(:, :) ! liquid  water flux (convection ) kgH2O/m2/s
     328  REAL, INTENT(in) :: flxsst(:, :) ! solid  water flux (stratiform) kgH2O/m2/s
     329  REAL, INTENT(in) :: flxscv(:, :) ! solid  water flux (convection) kgH2O/m2/s
     330  REAL, INTENT(in) :: pctsrf(:, :)  ! subsurface fraction (0..1)
     331  REAL, INTENT(in) :: area(:)          ! surface area of grid box [m2]
     332  REAL, INTENT(in) :: rlon(:)          ! longitude
     333  REAL, INTENT(in) :: rlat(:)          ! latitude
     334  REAL, INTENT(in) :: u10m(:, :)    ! vents a 10m
     335  REAL, INTENT(in) :: v10m(:, :)    ! vents a 10m
     336
     337  CALL lmdz_inca_wrapper_abort
     338END SUBROUTINE AEROSOL_METEO_CALC
    171339
    172340#endif

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_mpi_wrappers.F90

    r5101 r5103  
    1 ! mpi subroutine wrappers
     1! mpi SUBROUTINE wrappers
    22
    33#ifndef CPP_MPI

  • LMDZ6/branches/Amaury_dev/libf/misc/new_unit_m.F90

    r5086 r5103  
    55contains
    66
    7   subroutine new_unit(unit)
     7  SUBROUTINE new_unit(unit)
    88
    99    integer, intent(out):: unit
    … …  
    2121    END DO
    2222
    23   end subroutine new_unit
     23  END SUBROUTINE new_unit
    2424
    2525end module new_unit_m

  • LMDZ6/branches/Amaury_dev/libf/misc/pchfe_95_m.F90

    r5101 r5103  
    7272    CALL PCHFE(N, X, F, D, 1, SKIP, NE, XE, FE, IERR)
    7373
    74   end SUBROUTINE PCHFE_95
     74  END SUBROUTINE PCHFE_95
    7575
    7676end module PCHFE_95_m

  • LMDZ6/branches/Amaury_dev/libf/misc/q_sat.F

    r5099 r5103  
    44
    55
    6       subroutine q_sat(np,temp,pres,qsat)
     6      SUBROUTINE q_sat(np,temp,pres,qsat)
    77
    88      IMPLICIT none

  • LMDZ6/branches/Amaury_dev/libf/misc/strings_mod.F90

    r5003 r5103  
    11MODULE strings_mod
    2 
    3   IMPLICIT NONE
    4 
    5   PRIVATE
     2  IMPLICIT NONE; PRIVATE
    63  PUBLIC :: maxlen, init_printout, msg, fmsg, get_in, lunout, prt_level
    74  PUBLIC :: strLower, strHead, strStack,  strCount, strReduce,  strClean, strIdx
    … …  
    4138!==============================================================================================================================
    4239SUBROUTINE init_printout(lunout_, prt_level_)
    43   IMPLICIT NONE
    44   INTEGER, INTENT(IN) :: lunout_, prt_level_
     40    INTEGER, INTENT(IN) :: lunout_, prt_level_
    4541  lunout    = lunout_
    4642  prt_level = prt_level_
    … …  
    5349!==============================================================================================================================
    5450SUBROUTINE getin_s(nam, val, def)
    55   USE ioipsl_getincom, ONLY: getin
    56   IMPLICIT NONE
    57   CHARACTER(LEN=*), INTENT(IN)    :: nam
     51  USE IOIPSL, ONLY: getin
     52    CHARACTER(LEN=*), INTENT(IN)    :: nam
    5853  CHARACTER(LEN=*), INTENT(INOUT) :: val
    5954  CHARACTER(LEN=*), INTENT(IN)    :: def
    … …  
    6358!==============================================================================================================================
    6459SUBROUTINE getin_i(nam, val, def)
    65   USE ioipsl_getincom, ONLY: getin
    66   IMPLICIT NONE
     60  USE IOIPSL, ONLY: getin
    6761  CHARACTER(LEN=*), INTENT(IN)    :: nam
    6862  INTEGER,          INTENT(INOUT) :: val
    … …  
    7367!==============================================================================================================================
    7468SUBROUTINE getin_r(nam, val, def)
    75   USE ioipsl_getincom, ONLY: getin
    76   IMPLICIT NONE
    77   CHARACTER(LEN=*), INTENT(IN)    :: nam
     69  USE IOIPSL,ONLY: getin
     70    CHARACTER(LEN=*), INTENT(IN)    :: nam
    7871  REAL,             INTENT(INOUT) :: val
    7972  REAL,             INTENT(IN)    :: def
    … …  
    8376!==============================================================================================================================
    8477SUBROUTINE getin_l(nam, val, def)
    85   USE ioipsl_getincom, ONLY: getin
    86   IMPLICIT NONE
    87   CHARACTER(LEN=*), INTENT(IN)    :: nam
     78  USE IOIPSL, ONLY: getin
     79    CHARACTER(LEN=*), INTENT(IN)    :: nam
    8880  LOGICAL,          INTENT(INOUT) :: val
    8981  LOGICAL,          INTENT(IN)    :: def
    … …  
    9890!==============================================================================================================================
    9991SUBROUTINE msg_1(str, modname, ll, unit)
    100   IMPLICIT NONE
    101   !--- Display a simple message "str". Optional parameters:
     92    !--- Display a simple message "str". Optional parameters:
    10293  !    * "modname": module name, displayed in front of the message (with ": " separator) if present.
    10394  !    * "ll":      message trigger ; message is displayed only if ll==.TRUE.
    … …  
    118109!==============================================================================================================================
    119110SUBROUTINE msg_m(str, modname, ll, unit, nmax)
    120   IMPLICIT NONE
    121   !--- Same as msg_1 with multiple strings that are stacked (separator: coma) on up to "nmax" full lines.
     111    !--- Same as msg_1 with multiple strings that are stacked (separator: coma) on up to "nmax" full lines.
    122112  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    123113  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
    … …  
    139129!==============================================================================================================================
    140130LOGICAL FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l)
    141   IMPLICIT NONE
    142   CHARACTER(LEN=*),           INTENT(IN) :: str
     131    CHARACTER(LEN=*),           INTENT(IN) :: str
    143132  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
    144133  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
    … …  
    154143!==============================================================================================================================
    155144LOGICAL FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l)
    156   IMPLICIT NONE
    157   CHARACTER(LEN=*),           INTENT(IN)  :: str(:)
     145    CHARACTER(LEN=*),           INTENT(IN)  :: str(:)
    158146  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
    159147  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
    … …  
    176164!==============================================================================================================================
    177165ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strLower(str) RESULT(out)
    178   IMPLICIT NONE
    179   CHARACTER(LEN=*), INTENT(IN) :: str
     166    CHARACTER(LEN=*), INTENT(IN) :: str
    180167  INTEGER :: k
    181168  out = str
    … …  
    186173!==============================================================================================================================
    187174ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strUpper(str) RESULT(out)
    188   IMPLICIT NONE
    189   CHARACTER(LEN=*), INTENT(IN) :: str
     175    CHARACTER(LEN=*), INTENT(IN) :: str
    190176  INTEGER :: k
    191177  out = str
    … …  
    204190!==============================================================================================================================
    205191CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(out)
    206   IMPLICIT NONE
    207   CHARACTER(LEN=*),           INTENT(IN) :: str
     192    CHARACTER(LEN=*),           INTENT(IN) :: str
    208193  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    209194  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackward
    … …  
    220205!==============================================================================================================================
    221206FUNCTION strHead_m(str, sep, lBackward) RESULT(out)
    222   IMPLICIT NONE
    223   CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
     207    CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    224208  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    225209  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    … …  
    242226!==============================================================================================================================
    243227CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(out)
    244   IMPLICIT NONE
    245   CHARACTER(LEN=*),           INTENT(IN) :: str
     228    CHARACTER(LEN=*),           INTENT(IN) :: str
    246229  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    247230  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackWard
    … …  
    258241!==============================================================================================================================
    259242FUNCTION strTail_m(str, sep, lBackWard) RESULT(out)
    260   IMPLICIT NONE
    261   CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
     243    CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    262244  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    263245  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    … …  
    280262!==============================================================================================================================
    281263FUNCTION strStack(str, sep, mask) RESULT(out)
    282   IMPLICIT NONE
    283   CHARACTER(LEN=:),          ALLOCATABLE :: out
     264    CHARACTER(LEN=:),          ALLOCATABLE :: out
    284265  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    285266  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    … …  
    302283!==============================================================================================================================
    303284FUNCTION strStackm(str, sep, nmax) RESULT(out)
    304   IMPLICIT NONE
    305   CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
     285    CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    306286  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    307287  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    … …  
    335315!==============================================================================================================================
    336316SUBROUTINE strClean_1(str)
    337   IMPLICIT NONE
    338   CHARACTER(LEN=*), INTENT(INOUT) :: str
     317    CHARACTER(LEN=*), INTENT(INOUT) :: str
    339318  INTEGER :: k, n, m
    340319  n = LEN(str)
    … …  
    349328!==============================================================================================================================
    350329SUBROUTINE strClean_m(str)
    351   IMPLICIT NONE
    352   CHARACTER(LEN=*), INTENT(INOUT) :: str(:)
     330    CHARACTER(LEN=*), INTENT(INOUT) :: str(:)
    353331  INTEGER :: k
    354332  DO k = 1, SIZE(str); CALL strClean_1(str(k)); END DO
    … …  
    362340!==============================================================================================================================
    363341SUBROUTINE strReduce_1(str, nb)
    364   IMPLICIT NONE
    365   CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
     342    CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
    366343  INTEGER,          OPTIONAL,    INTENT(OUT)   :: nb
    367344!------------------------------------------------------------------------------------------------------------------------------
    … …  
    380357!==============================================================================================================================
    381358SUBROUTINE strReduce_2(str1, str2)
    382   IMPLICIT NONE
    383   CHARACTER(LEN=*),   ALLOCATABLE, INTENT(INOUT) :: str1(:)
     359    CHARACTER(LEN=*),   ALLOCATABLE, INTENT(INOUT) :: str1(:)
    384360  CHARACTER(LEN=*),                INTENT(IN)    :: str2(:)
    385361!------------------------------------------------------------------------------------------------------------------------------
    … …  
    407383!==============================================================================================================================
    408384INTEGER FUNCTION strIdx_1(str, s) RESULT(out)
    409   IMPLICIT NONE
    410   CHARACTER(LEN=*), INTENT(IN) :: str(:), s
     385    CHARACTER(LEN=*), INTENT(IN) :: str(:), s
    411386  DO out = 1, SIZE(str); IF(str(out) == s) EXIT; END DO
    412387  IF(out == 1+SIZE(str) .OR. SIZE(str)==0) out = 0
    … …  
    414389!==============================================================================================================================
    415390FUNCTION strIdx_m(str, s, n) RESULT(out)
    416   IMPLICIT NONE
    417   CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
     391    CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
    418392  INTEGER, OPTIONAL, INTENT(OUT) :: n
    419393  INTEGER,           ALLOCATABLE :: out(:)
    … …  
    430404!==============================================================================================================================
    431405FUNCTION strFind_1(str, s, n) RESULT(out)
    432   IMPLICIT NONE
    433   CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s
     406    CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s
    434407  INTEGER, OPTIONAL, INTENT(OUT) :: n
    435408  INTEGER,           ALLOCATABLE :: out(:)
    … …  
    441414!==============================================================================================================================
    442415FUNCTION strFind_m(str, s, n) RESULT(out)
    443   IMPLICIT NONE
    444   CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
     416    CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
    445417  INTEGER, OPTIONAL, INTENT(OUT) :: n
    446418  INTEGER,           ALLOCATABLE :: out(:)
    … …  
    452424!==============================================================================================================================
    453425FUNCTION intFind_1(i,j,n) RESULT(out)
    454   IMPLICIT NONE
    455   INTEGER,           INTENT(IN)  :: i(:), j
     426    INTEGER,           INTENT(IN)  :: i(:), j
    456427  INTEGER, OPTIONAL, INTENT(OUT) :: n
    457428  INTEGER,           ALLOCATABLE :: out(:)
    … …  
    463434!==============================================================================================================================
    464435FUNCTION intFind_m(i,j,n) RESULT(out)
    465   IMPLICIT NONE
    466   INTEGER,           INTENT(IN)  :: i(:), j(:)
     436    INTEGER,           INTENT(IN)  :: i(:), j(:)
    467437  INTEGER, OPTIONAL, INTENT(OUT) :: n
    468438  INTEGER,           ALLOCATABLE :: out(:)
    … …  
    474444!==============================================================================================================================
    475445FUNCTION booFind(l,n) RESULT(out)
    476    IMPLICIT NONE
    477  LOGICAL,           INTENT(IN)  :: l(:)
     446    LOGICAL,           INTENT(IN)  :: l(:)
    478447  INTEGER, OPTIONAL, INTENT(OUT) :: n
    479448  INTEGER,           ALLOCATABLE :: out(:)
    … …  
    492461!==============================================================================================================================
    493462LOGICAL FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr)
    494   IMPLICIT NONE
    495   CHARACTER(LEN=*),  INTENT(IN)  :: rawList                          !--- String in which delimiters have to be identified
     463    CHARACTER(LEN=*),  INTENT(IN)  :: rawList                          !--- String in which delimiters have to be identified
    496464  CHARACTER(LEN=*),  INTENT(IN)  :: del(:)                           !--- List of delimiters
    497465  INTEGER,           INTENT(IN)  :: ibeg                             !--- Start index
    … …  
    502470  INTEGER :: idx0                                                    !--- Used to display an identified non-numeric string
    503471  lerr = .FALSE.
    504   idx = strIdx1(rawList, del, ibeg, idel)                            !--- idx/=0: del(idel) is at position "idx" in "rawList" 
     472  idx = strIdx1(rawList, del, ibeg, idel)                            !--- idx/=0: del(idel) is at position "idx" in "rawList"
    505473  IF(.NOT.PRESENT(lSc))               RETURN                         !--- No need to check exceptions for numbers => finished
    506474  IF(.NOT.        lSc )               RETURN                         !--- No need to check exceptions for numbers => finished
    … …  
    529497!--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib".
    530498!--- "id" is the index in "del(:)" of the first delimiter found.
    531   IMPLICIT NONE
    532   CHARACTER(LEN=*),  INTENT(IN)  :: str, del(:)
     499    CHARACTER(LEN=*),  INTENT(IN)  :: str, del(:)
    533500  INTEGER,           INTENT(IN)  :: ib
    534501  INTEGER,           INTENT(OUT) :: id
    … …  
    546513!==============================================================================================================================
    547514LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
    548   IMPLICIT NONE
    549   CHARACTER(LEN=*),  INTENT(IN)  :: rawList
     515    CHARACTER(LEN=*),  INTENT(IN)  :: rawList
    550516  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter
    551517  INTEGER,           INTENT(OUT) :: nb
    … …  
    558524!==============================================================================================================================
    559525LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
    560   IMPLICIT NONE
    561   CHARACTER(LEN=*),     INTENT(IN)  :: rawList(:)
     526    CHARACTER(LEN=*),     INTENT(IN)  :: rawList(:)
    562527  CHARACTER(LEN=*),     INTENT(IN)  :: delimiter
    563528  INTEGER, ALLOCATABLE, INTENT(OUT) :: nb(:)
    … …  
    575540!==============================================================================================================================
    576541LOGICAL FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr)
    577   IMPLICIT NONE
    578   CHARACTER(LEN=*),  INTENT(IN)  :: rawList
     542    CHARACTER(LEN=*),  INTENT(IN)  :: rawList
    579543  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter(:)
    580544  INTEGER,           INTENT(OUT) :: nb
    … …  
    606570!==============================================================================================================================
    607571LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
    608   IMPLICIT NONE
    609   CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter
     572    CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter
    610573  CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: keys(:)
    611574  INTEGER,                            OPTIONAL, INTENT(OUT) :: n
    … …  
    627590INTEGER FUNCTION countK() RESULT(nkeys)
    628591!--- Get the number of elements after parsing.
    629   IMPLICIT NONE
    630 !------------------------------------------------------------------------------------------------------------------------------
     592  !------------------------------------------------------------------------------------------------------------------------------
    631593  INTEGER :: ib, ie, nl
    632594  nkeys = 1; ib = 1; nl = LEN(delimiter)
    … …  
    645607SUBROUTINE parseK(keys)
    646608!--- Parse the string separated by "delimiter" from "rawList" into "keys(:)"
    647   IMPLICIT NONE
    648   CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:)
     609    CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:)
    649610!------------------------------------------------------------------------------------------------------------------------------
    650611  INTEGER :: ib, ie, ik
    … …  
    664625SUBROUTINE parseV(vals)
    665626!--- Parse the <key>=<val> pairs in "keys(:)" into "keys" and "vals"
    666   IMPLICIT NONE
    667   CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: vals(:)
     627    CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: vals(:)
    668628!------------------------------------------------------------------------------------------------------------------------------
    669629  CHARACTER(LEN=maxlen) :: key
    … …  
    681641!==============================================================================================================================
    682642LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
    683   IMPLICIT NONE
    684   CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter(:)
     643    CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter(:)
    685644  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: keys(:)  !--- Parsed keys vector
    686645  INTEGER,               OPTIONAL,              INTENT(OUT) :: n        !--- Length of the parsed vector
    … …  
    722681!------------------------------------------------------------------------------------------------------------------------------
    723682SUBROUTINE parseKeys(key, val)
    724   IMPLICIT NONE
    725   CHARACTER(LEN=*), INTENT(INOUT) :: key
     683    CHARACTER(LEN=*), INTENT(INOUT) :: key
    726684  CHARACTER(LEN=*), INTENT(OUT)   :: val
    727685!------------------------------------------------------------------------------------------------------------------------------
    … …  
    732690END SUBROUTINE parseKeys
    733691
    734 END FUNCTION strParse_m   
     692END FUNCTION strParse_m
    735693!==============================================================================================================================
    736694
    … …  
    740698!==============================================================================================================================
    741699SUBROUTINE strReplace_1(str, key, val, lsurr)
    742   IMPLICIT NONE
    743   CHARACTER(LEN=*),  INTENT(INOUT) :: str        !--- Main string
     700    CHARACTER(LEN=*),  INTENT(INOUT) :: str        !--- Main string
    744701  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
    745702  LOGICAL, OPTIONAL, INTENT(IN)    :: lsurr      !--- TRUE => key must be surrounded by special characters to be substituted
    … …  
    767724!==============================================================================================================================
    768725SUBROUTINE strReplace_m(str, key, val, lsurr)
    769   IMPLICIT NONE
    770   CHARACTER(LEN=*),  INTENT(INOUT) :: str(:)     !--- Main strings vector
     726    CHARACTER(LEN=*),  INTENT(INOUT) :: str(:)     !--- Main strings vector
    771727  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
    772728  LOGICAL, OPTIONAL, INTENT(IN)    :: lsurr      !--- TRUE => key must be surrounded by special characters to be substituted
    … …  
    783739!==============================================================================================================================
    784740FUNCTION horzcat_s00(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
    785   IMPLICIT NONE
    786   CHARACTER(LEN=*),                   INTENT(IN) :: s0
     741    CHARACTER(LEN=*),                   INTENT(IN) :: s0
    787742  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
    788743  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
    … …  
    805760!==============================================================================================================================
    806761FUNCTION horzcat_s10(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
    807   IMPLICIT NONE
    808   CHARACTER(LEN=*),           INTENT(IN) :: s0(:), s1
     762    CHARACTER(LEN=*),           INTENT(IN) :: s0(:), s1
    809763  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2, s3, s4, s5, s6, s7, s8, s9
    810764  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:), tmp(:)
    … …  
    817771!==============================================================================================================================
    818772FUNCTION horzcat_s11(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
    819   IMPLICIT NONE
    820   CHARACTER(LEN=*),                   INTENT(IN) :: s0(:)
     773    CHARACTER(LEN=*),                   INTENT(IN) :: s0(:)
    821774  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1(:), s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
    822775  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
    … …  
    842795!==============================================================================================================================
    843796FUNCTION horzcat_s21(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
    844   IMPLICIT NONE
    845   CHARACTER(LEN=*),           INTENT(IN) :: s0(:,:), s1(:)
     797    CHARACTER(LEN=*),           INTENT(IN) :: s0(:,:), s1(:)
    846798  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
    847799  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), tmp(:,:)
    … …  
    854806!==============================================================================================================================
    855807FUNCTION horzcat_i00(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
    856   IMPLICIT NONE
    857   INTEGER,                   INTENT(IN) :: i0
     808    INTEGER,                   INTENT(IN) :: i0
    858809  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
    859810  INTEGER, ALLOCATABLE :: out(:)
    … …  
    876827!==============================================================================================================================
    877828FUNCTION horzcat_i10(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
    878   IMPLICIT NONE
    879   INTEGER,           INTENT(IN) :: i0(:), i1
     829    INTEGER,           INTENT(IN) :: i0(:), i1
    880830  INTEGER, OPTIONAL, INTENT(IN) :: i2, i3, i4, i5, i6, i7, i8, i9
    881831  INTEGER, ALLOCATABLE :: out(:), tmp(:)
    … …  
    888838!==============================================================================================================================
    889839FUNCTION horzcat_i11(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
    890   IMPLICIT NONE
    891   INTEGER,                   INTENT(IN) :: i0(:)
     840    INTEGER,                   INTENT(IN) :: i0(:)
    892841  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1(:), i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
    893842  INTEGER, ALLOCATABLE :: out(:,:)
    … …  
    913862!==============================================================================================================================
    914863FUNCTION horzcat_i21(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
    915   IMPLICIT NONE
    916   INTEGER,           INTENT(IN) :: i0(:,:), i1(:)
     864    INTEGER,           INTENT(IN) :: i0(:,:), i1(:)
    917865  INTEGER, OPTIONAL, INTENT(IN) :: i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
    918866  INTEGER, ALLOCATABLE :: out(:,:), tmp(:,:)
    … …  
    925873!==============================================================================================================================
    926874FUNCTION horzcat_r00(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    927   IMPLICIT NONE
    928   REAL,                   INTENT(IN) :: r0
     875    REAL,                   INTENT(IN) :: r0
    929876  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
    930877  REAL, ALLOCATABLE :: out(:)
    … …  
    947894!==============================================================================================================================
    948895FUNCTION horzcat_r10(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    949   IMPLICIT NONE
    950   REAL,           INTENT(IN) :: r0(:), r1
     896    REAL,           INTENT(IN) :: r0(:), r1
    951897  REAL, OPTIONAL, INTENT(IN) :: r2, r3, r4, r5, r6, r7, r8, r9
    952898  REAL, ALLOCATABLE :: out(:), tmp(:)
    … …  
    959905!==============================================================================================================================
    960906FUNCTION horzcat_r11(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    961   IMPLICIT NONE
    962   REAL,                   INTENT(IN) :: r0(:)
     907    REAL,                   INTENT(IN) :: r0(:)
    963908  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1(:), r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
    964909  REAL, ALLOCATABLE :: out(:,:)
    … …  
    984929!==============================================================================================================================
    985930FUNCTION horzcat_r21(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    986   IMPLICIT NONE
    987   REAL,           INTENT(IN) :: r0(:,:), r1(:)
     931    REAL,           INTENT(IN) :: r0(:,:), r1(:)
    988932  REAL, OPTIONAL, INTENT(IN) :: r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
    989933  REAL, ALLOCATABLE :: out(:,:), tmp(:,:)
    … …  
    996940!==============================================================================================================================
    997941FUNCTION horzcat_d00(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    998   IMPLICIT NONE
    999   DOUBLE PRECISION,                   INTENT(IN) :: d0
     942    DOUBLE PRECISION,                   INTENT(IN) :: d0
    1000943  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
    1001944  DOUBLE PRECISION, ALLOCATABLE :: out(:)
    … …  
    1018961!==============================================================================================================================
    1019962FUNCTION horzcat_d10(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    1020   IMPLICIT NONE
    1021   DOUBLE PRECISION,           INTENT(IN) :: d0(:), d1
     963    DOUBLE PRECISION,           INTENT(IN) :: d0(:), d1
    1022964  DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2, d3, d4, d5, d6, d7, d8, d9
    1023965  DOUBLE PRECISION, ALLOCATABLE :: out(:), tmp(:)
    … …  
    1030972!==============================================================================================================================
    1031973FUNCTION horzcat_d11(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    1032   IMPLICIT NONE
    1033   DOUBLE PRECISION,                   INTENT(IN) :: d0(:)
     974    DOUBLE PRECISION,                   INTENT(IN) :: d0(:)
    1034975  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1(:), d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
    1035976  DOUBLE PRECISION, ALLOCATABLE :: out(:,:)
    … …  
    1054995!==============================================================================================================================
    1055996FUNCTION horzcat_d21(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    1056   IMPLICIT NONE
    1057   DOUBLE PRECISION,           INTENT(IN) :: d0(:,:), d1(:)
     997    DOUBLE PRECISION,           INTENT(IN) :: d0(:,:), d1(:)
    1058998  DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
    1059999  DOUBLE PRECISION, ALLOCATABLE :: out(:,:), tmp(:,:)
    … …  
    10751015!==============================================================================================================================
    10761016LOGICAL FUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
    1077   IMPLICIT NONE
    1078   CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
     1017    CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
    10791018  CHARACTER(LEN=*),           INTENT(IN)  :: titles(:)     !--- TITLES (ONE EACH COLUMN)
    10801019  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: s(:,:)        !--- STRINGS
    … …  
    11561095    ncmx(nt) = ncol
    11571096  END IF
    1158      
     1097
    11591098  !--- Display the strings array as a table
    11601099  DO it = 1, nt
    … …  
    11841123!==============================================================================================================================
    11851124LOGICAL FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr)
    1186   IMPLICIT NONE
    1187   INTEGER,                    INTENT(IN)  :: unt           !--- Output unit
     1125    INTEGER,                    INTENT(IN)  :: unt           !--- Output unit
    11881126  CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
    11891127  CHARACTER(LEN=*),           INTENT(IN)  :: titles(:)     !--- TITLES (ONE EACH COLUMN)
    … …  
    12671205!==============================================================================================================================
    12681206LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr)
    1269   IMPLICIT NONE
    1270 ! Display outliers list in tables
     1207  ! Display outliers list in tables
    12711208! If "nam" is supplied, it means the last index is for tracers => one table each tracer for rank > 2.
    12721209  LOGICAL,                    INTENT(IN)  :: ll(:)                   !--- Linearized mask of outliers
    12731210  REAL,                       INTENT(IN)  ::  a(:)                   !--- Linearized array of values
    12741211  INTEGER,                    INTENT(IN)  ::  n(:)                   !--- Profile before linearization
    1275   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), subn   !--- Error message, variables and calling subroutine names
     1212  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), subn   !--- Error message, variables and calling SUBROUTINE names
    12761213  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Maximum number of lines to display    (default: all)
    12771214  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax                 !--- Maximum number of characters per line (default: 2048)
    … …  
    12901227  mes = 'outliers found'; IF(PRESENT(err_msg)) mes = err_msg         !--- Error message
    12911228  vnm = ['a'];            IF(PRESENT(nam ))    vnm = nam             !--- Variables names
    1292   sub = 'dispOutliers';   IF(PRESENT(subn))    sub = subn            !--- Calling subroutine name
     1229  sub = 'dispOutliers';   IF(PRESENT(subn))    sub = subn            !--- Calling SUBROUTINE name
    12931230  nRmx= SIZE(a);          IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)!-- Maximum number of lines to print
    12941231  nCmx= 2048;             IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)!-- Maximum number of characters each line
    … …  
    13461283!==============================================================================================================================
    13471284LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr)
    1348   IMPLICIT NONE
    1349 ! Display outliers list in tables
     1285  ! Display outliers list in tables
    13501286! If "nam" is supplied and, it means the last index is for tracers => one table each tracer for rank > 2.
    13511287  LOGICAL,                    INTENT(IN)  :: ll(:)                   !--- Linearized mask of outliers
    13521288  REAL,                       INTENT(IN)  ::  a(:,:)                 !--- Linearized arrays of values stacked along 2nd dim.
    13531289  INTEGER,                    INTENT(IN)  ::  n(:)                   !--- Profile before linearization
    1354   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), subn   !--- Error message, variables and calling subroutine names
     1290  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), subn   !--- Error message, variables and calling SUBROUTINE names
    13551291  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Maximum number of lines to display    (default: all)
    13561292  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax                 !--- Maximum number of characters per line (default: 2048)
    … …  
    13681304  mes = 'outliers found';        IF(PRESENT(err_msg)) mes = err_msg  !--- Error message
    13691305  vnm = [(ACHAR(k+96),k=1,nv)];  IF(PRESENT(nam ))    vnm = nam      !--- Variables names
    1370   sub = 'dispOutliers';          IF(PRESENT(subn))    sub = subn     !--- Calling subroutine name
     1306  sub = 'dispOutliers';          IF(PRESENT(subn))    sub = subn     !--- Calling SUBROUTINE name
    13711307  nRmx= SIZE(a);          IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)!-- Maximum number of lines to print
    13721308  nCmx= 2048;             IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)!-- Maximum number of characters each line
    … …  
    14041340!==============================================================================================================================
    14051341LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(lerr)
    1406   IMPLICIT NONE
    1407   CHARACTER(LEN=*),      INTENT(IN)  :: str
     1342    CHARACTER(LEN=*),      INTENT(IN)  :: str
    14081343  CHARACTER(LEN=maxlen), INTENT(OUT) :: val
    14091344!------------------------------------------------------------------------------------------------------------------------------
    … …  
    14541389!==============================================================================================================================
    14551390LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(lerr)
    1456   IMPLICIT NONE
    1457   CHARACTER(LEN=*),      INTENT(IN)  :: str
     1391    CHARACTER(LEN=*),      INTENT(IN)  :: str
    14581392  CHARACTER(LEN=*),      INTENT(OUT) :: val
    14591393  DOUBLE PRECISION,      ALLOCATABLE :: vl(:)
    … …  
    14981432!==============================================================================================================================
    14991433FUNCTION reduceExpr_m(str, val) RESULT(lerr)
    1500   IMPLICIT NONE
    1501   LOGICAL,               ALLOCATABLE              :: lerr(:)
     1434    LOGICAL,               ALLOCATABLE              :: lerr(:)
    15021435  CHARACTER(LEN=*),                   INTENT(IN)  :: str(:)
    15031436  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
    … …  
    15141447!==============================================================================================================================
    15151448ELEMENTAL LOGICAL FUNCTION is_numeric(str) RESULT(out)
    1516   IMPLICIT NONE
    1517   CHARACTER(LEN=*), INTENT(IN) :: str
     1449    CHARACTER(LEN=*), INTENT(IN) :: str
    15181450  REAL    :: x
    15191451  INTEGER :: e
    … …  
    15311463!==============================================================================================================================
    15321464ELEMENTAL INTEGER FUNCTION str2bool(str) RESULT(out)  !--- Result: 0/1 for .FALSE./.TRUE., -1 if not a valid boolean
    1533   IMPLICIT NONE
    1534   CHARACTER(LEN=*), INTENT(IN) :: str
     1465    CHARACTER(LEN=*), INTENT(IN) :: str
    15351466  INTEGER :: ierr
    15361467  LOGICAL :: lout
    … …  
    15381469  out = -HUGE(1)
    15391470  IF(ierr /= 0) THEN
    1540     IF(ANY(['.false.', 'false  ', 'no     ', 'f      ', 'n      '] == strLower(str))) out = 0
    1541     IF(ANY(['.true. ', 'true   ', 'yes    ', 't      ', 'y      '] == strLower(str))) out = 1
     1471    IF(ANY(['.FALSE.', 'false  ', 'no     ', 'f      ', 'n      '] == strLower(str))) out = 0
     1472    IF(ANY(['.TRUE. ', 'true   ', 'yes    ', 't      ', 'y      '] == strLower(str))) out = 1
    15421473  ELSE
    15431474    out = 0; IF(lout) out = 1
    … …  
    15461477!==============================================================================================================================
    15471478ELEMENTAL INTEGER FUNCTION str2int(str) RESULT(out)
    1548   IMPLICIT NONE
    1549   CHARACTER(LEN=*), INTENT(IN) :: str
     1479    CHARACTER(LEN=*), INTENT(IN) :: str
    15501480  INTEGER :: ierr
    15511481  READ(str,*,IOSTAT=ierr) out
    … …  
    15541484!==============================================================================================================================
    15551485ELEMENTAL REAL FUNCTION str2real(str) RESULT(out)
    1556   IMPLICIT NONE
    1557   CHARACTER(LEN=*), INTENT(IN) :: str
     1486    CHARACTER(LEN=*), INTENT(IN) :: str
    15581487  INTEGER :: ierr
    15591488  READ(str,*,IOSTAT=ierr) out
    … …  
    15621491!==============================================================================================================================
    15631492ELEMENTAL DOUBLE PRECISION FUNCTION str2dble(str) RESULT(out)
    1564   IMPLICIT NONE
    1565   CHARACTER(LEN=*), INTENT(IN) :: str
     1493    CHARACTER(LEN=*), INTENT(IN) :: str
    15661494  INTEGER :: ierr
    15671495  READ(str,*,IOSTAT=ierr) out
    … …  
    15701498!==============================================================================================================================
    15711499ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION bool2str(b) RESULT(out)
    1572   IMPLICIT NONE
    1573   LOGICAL, INTENT(IN) :: b
     1500    LOGICAL, INTENT(IN) :: b
    15741501  WRITE(out,*)b
    15751502  out = ADJUSTL(out)
    … …  
    15771504!==============================================================================================================================
    15781505ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION int2str(i, nDigits) RESULT(out)
    1579   IMPLICIT NONE
    1580   INTEGER,           INTENT(IN) :: i
     1506    INTEGER,           INTENT(IN) :: i
    15811507  INTEGER, OPTIONAL, INTENT(IN) :: nDigits
    15821508!------------------------------------------------------------------------------------------------------------------------------
    … …  
    15881514!==============================================================================================================================
    15891515ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(out)
    1590   IMPLICIT NONE
    1591   REAL,                       INTENT(IN) :: r
     1516    REAL,                       INTENT(IN) :: r
    15921517  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
    15931518!------------------------------------------------------------------------------------------------------------------------------
    … …  
    15981523!==============================================================================================================================
    15991524ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION dble2str(d,fmt) RESULT(out)
    1600   IMPLICIT NONE
    1601   DOUBLE PRECISION,           INTENT(IN) :: d
     1525    DOUBLE PRECISION,           INTENT(IN) :: d
    16021526  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
    16031527!------------------------------------------------------------------------------------------------------------------------------
    … …  
    16081532!==============================================================================================================================
    16091533ELEMENTAL SUBROUTINE cleanZeros(s)
    1610   IMPLICIT NONE
    1611   CHARACTER(LEN=*), INTENT(INOUT) :: s
     1534    CHARACTER(LEN=*), INTENT(INOUT) :: s
    16121535  INTEGER :: ls, ix, i
    16131536  IF(is_numeric(s)) THEN
    … …  
    16261549!==============================================================================================================================
    16271550FUNCTION addQuotes_1(s) RESULT(out)
    1628   IMPLICIT NONE
    1629   CHARACTER(LEN=*), INTENT(IN)  :: s
     1551    CHARACTER(LEN=*), INTENT(IN)  :: s
    16301552  CHARACTER(LEN=:), ALLOCATABLE :: out
    16311553  IF(needQuotes(s)) THEN; out = "'"//TRIM(s)//"'"; ELSE; out = s; END IF
    … …  
    16331555!==============================================================================================================================
    16341556FUNCTION addQuotes_m(s) RESULT(out)
    1635   IMPLICIT NONE
    1636   CHARACTER(LEN=*), INTENT(IN)  :: s(:)
     1557    CHARACTER(LEN=*), INTENT(IN)  :: s(:)
    16371558  CHARACTER(LEN=:), ALLOCATABLE :: out(:)
    16381559!------------------------------------------------------------------------------------------------------------------------------
    … …  
    16461567!==============================================================================================================================
    16471568ELEMENTAL LOGICAL FUNCTION needQuotes(s) RESULT(out)
    1648   IMPLICIT NONE
    1649   CHARACTER(LEN=*), INTENT(IN) :: s
     1569    CHARACTER(LEN=*), INTENT(IN) :: s
    16501570  CHARACTER(LEN=1) :: b, e
    16511571!------------------------------------------------------------------------------------------------------------------------------
    … …  
    16611581!==============================================================================================================================
    16621582LOGICAL FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out)
    1663   IMPLICIT NONE
    1664 ! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector).
     1583  ! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector).
    16651584! Note:    Return value "out" is .TRUE. if there are errors (ie at least one element of "lerr" is TRUE).
    16661585  CHARACTER(LEN=*),   INTENT(IN)  :: str(:)
    … …  
    16841603!==============================================================================================================================
    16851604SUBROUTINE removeComment(str)
    1686   IMPLICIT NONE
    1687   CHARACTER(LEN=*), INTENT(INOUT) :: str
     1605    CHARACTER(LEN=*), INTENT(INOUT) :: str
    16881606  INTEGER :: ix
    16891607  ix = INDEX(str,'# '); IF(ix /= 0) str = str(1:ix-1)//REPEAT(' ',LEN(str)-ix+1)

  • LMDZ6/branches/Amaury_dev/libf/misc/vampir.F90

    r5101 r5103  
    1515contains
    1616
    17   subroutine InitVampir
     17  SUBROUTINE InitVampir
    1818    implicit none
    1919
    … …  
    4747    ierr = MPE_Describe_state( MPE_begin(VTinca), MPE_end(VTinca),"inca", "LightBlue" )
    4848#endif     
    49   end subroutine InitVampir
     49  END SUBROUTINE InitVampir
    5050
    51   subroutine VTb(number)
     51  SUBROUTINE VTb(number)
    5252    implicit none
    5353    INTEGER :: number
    … …  
    6464#endif
    6565
    66   end subroutine VTb
     66  END SUBROUTINE VTb
    6767
    68   subroutine VTe(number)
     68  SUBROUTINE VTe(number)
    6969    implicit none
    7070    INTEGER :: Number
    … …  
    8282#endif
    8383
    84   end subroutine VTe
     84  END SUBROUTINE VTe
    8585 
    8686end module Vampir

  • LMDZ6/branches/Amaury_dev/libf/misc/write_field.F90

    r5101 r5103  
    11module write_field
    22  USE netcdf, ONLY: nf90_sync, nf90_put_var, nf90_enddef, nf90_def_dim, nf90_unlimited, &
    3       nf90_clobber, nf90_create, nf90_def_var
     3          nf90_clobber, nf90_create, nf90_def_var
    44  USE lmdz_cppkeys_wrapper, ONLY: nf90_format
    5 
    6   implicit none
     5  USE strings_mod, ONLY: int2str
     6
     7  IMPLICIT NONE; PRIVATE
     8  PUBLIC WriteField
    79
    810  integer, parameter :: MaxWriteField = 100
    9   integer, dimension(MaxWriteField),save :: FieldId
    10   integer, dimension(MaxWriteField),save :: FieldVarId
    11   integer, dimension(MaxWriteField),save :: FieldIndex
    12   character(len=255), dimension(MaxWriteField) ::  FieldName
    13    
    14   integer,save :: NbField = 0
    15  
     11  integer, dimension(MaxWriteField), save :: FieldId
     12  integer, dimension(MaxWriteField), save :: FieldVarId
     13  integer, dimension(MaxWriteField), save :: FieldIndex
     14  character(len = 255), dimension(MaxWriteField) :: FieldName
     15
     16  integer, save :: NbField = 0
     17
    1618  interface WriteField
    17     module procedure WriteField3d,WriteField2d,WriteField1d
     19    module procedure WriteField3d, WriteField2d, WriteField1d
    1820  end interface WriteField
    19   contains
    20  
    21     function GetFieldIndex(name)
    22     implicit none
    23       integer          :: GetFieldindex
    24       character(len=*) :: name
    25    
    26       character(len=255) :: TrueName
    27       integer            :: i
    28        
    29      
    30       TrueName=TRIM(ADJUSTL(name))
    31    
    32       GetFieldIndex=-1
    33       do i=1,NbField
    34         if (TrueName==FieldName(i)) then
    35           GetFieldIndex=i
    36           exit
     21contains
     22
     23  function GetFieldIndex(name)
     24    implicit none
     25    integer :: GetFieldindex
     26    character(len = *) :: name
     27
     28    character(len = 255) :: TrueName
     29    integer :: i
     30
     31    TrueName = TRIM(ADJUSTL(name))
     32
     33    GetFieldIndex = -1
     34    do i = 1, NbField
     35      if (TrueName==FieldName(i)) then
     36        GetFieldIndex = i
     37        exit
     38      endif
     39    enddo
     40  end function GetFieldIndex
     41
     42  subroutine WriteField3d(name, Field)
     43    implicit none
     44    character(len = *) :: name
     45    real, dimension(:, :, :) :: Field
     46    integer, dimension(3) :: Dim
     47
     48    Dim = shape(Field)
     49    CALL WriteField_gen(name, Field, Dim(1), Dim(2), Dim(3))
     50
     51  end subroutine WriteField3d
     52
     53  subroutine WriteField2d(name, Field)
     54    implicit none
     55    character(len = *) :: name
     56    real, dimension(:, :) :: Field
     57    integer, dimension(2) :: Dim
     58
     59    Dim = shape(Field)
     60    CALL WriteField_gen(name, Field, Dim(1), Dim(2), 1)
     61
     62  end subroutine WriteField2d
     63
     64  subroutine WriteField1d(name, Field)
     65    implicit none
     66    character(len = *) :: name
     67    real, dimension(:) :: Field
     68    integer, dimension(1) :: Dim
     69
     70    Dim = shape(Field)
     71    CALL WriteField_gen(name, Field, Dim(1), 1, 1)
     72
     73  end subroutine WriteField1d
     74
     75  subroutine WriteField_gen(name, Field, dimx, dimy, dimz)
     76    implicit none
     77    character(len = *) :: name
     78    integer :: dimx, dimy, dimz
     79    real, dimension(dimx, dimy, dimz) :: Field
     80    integer, dimension(dimx * dimy * dimz) :: ndex
     81    integer :: status
     82    integer :: index
     83    integer :: start(4)
     84    integer :: count(4)
     85
     86    Index = GetFieldIndex(name)
     87    if (Index==-1) then
     88      CALL CreateNewField(name, dimx, dimy, dimz)
     89      Index = GetFieldIndex(name)
     90    else
     91      FieldIndex(Index) = FieldIndex(Index) + 1.
     92    endif
     93
     94    start(1) = 1
     95    start(2) = 1
     96    start(3) = 1
     97    start(4) = FieldIndex(Index)
     98
     99    count(1) = dimx
     100    count(2) = dimy
     101    count(3) = dimz
     102    count(4) = 1
     103
     104    status = nf90_put_var(FieldId(Index), FieldVarId(Index), Field, start, count)
     105    status = nf90_sync(FieldId(Index))
     106
     107  end subroutine WriteField_gen
     108
     109  subroutine CreateNewField(name, dimx, dimy, dimz)
     110    implicit none
     111    character(len = *) :: name
     112    integer :: dimx, dimy, dimz
     113    integer :: TabDim(4)
     114    integer :: status
     115
     116    NbField = NbField + 1
     117    FieldName(NbField) = TRIM(ADJUSTL(name))
     118    FieldIndex(NbField) = 1
     119
     120    status = nf90_create(TRIM(ADJUSTL(name)) // '.nc', nf90_clobber, FieldId(NbField))
     121    status = nf90_def_dim(FieldId(NbField), 'X', dimx, TabDim(1))
     122    status = nf90_def_dim(FieldId(NbField), 'Y', dimy, TabDim(2))
     123    status = nf90_def_dim(FieldId(NbField), 'Z', dimz, TabDim(3))
     124    status = nf90_def_dim(FieldId(NbField), 'iter', nf90_unlimited, TabDim(4))
     125    status = nf90_def_var(FieldId(NbField), FieldName(NbField), nf90_format, TabDim, FieldVarId(NbField))
     126    status = nf90_enddef(FieldId(NbField))
     127
     128  end subroutine CreateNewField
     129
     130  subroutine write_field1D(name, Field)
     131    implicit none
     132
     133    integer, parameter :: MaxDim = 1
     134    character(len = *) :: name
     135    real, dimension(:) :: Field
     136    real, dimension(:), allocatable :: New_Field
     137    character(len = 20) :: str
     138    integer, dimension(MaxDim) :: Dim
     139    integer :: i, nb
     140    integer, parameter :: id = 10
     141    integer, parameter :: NbCol = 4
     142    integer :: ColumnSize
     143    integer :: pos
     144    character(len = 255) :: form
     145    character(len = 255) :: MaxLen
     146
     147    open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
     148    write (id, '("----- Field ' // name // '",//)')
     149    Dim = shape(Field)
     150    MaxLen = int2str(len(trim(int2str(Dim(1)))))
     151    ColumnSize = 20 + 6 + 3 + len(trim(int2str(Dim(1))))
     152    Nb = 0
     153    Pos = 2
     154    do i = 1, Dim(1)
     155      nb = nb + 1
     156
     157      if (MOD(nb, NbCol)==0) then
     158        form = '(t' // trim(int2str(pos)) // ',i' // trim(MaxLen) // '," ---> ",g22.16,/)'
     159        Pos = 2
     160      else
     161        form = '(t' // trim(int2str(pos)) // ',i' // trim(MaxLen) // '," ---> ",g22.16," | ",)'
     162        Pos = Pos + ColumnSize
     163      endif
     164      write (id, form, advance = 'no') i, Field(i)
     165    enddo
     166
     167    close(id)
     168
     169  end subroutine write_field1D
     170
     171  subroutine write_field2D(name, Field)
     172    implicit none
     173
     174    integer, parameter :: MaxDim = 2
     175    character(len = *) :: name
     176    real, dimension(:, :) :: Field
     177    real, dimension(:, :), allocatable :: New_Field
     178    character(len = 20) :: str
     179    integer, dimension(MaxDim) :: Dim
     180    integer :: i, j, nb
     181    integer, parameter :: id = 10
     182    integer, parameter :: NbCol = 4
     183    integer :: ColumnSize
     184    integer :: pos, offset
     185    character(len = 255) :: form
     186    character(len = 255) :: spacing
     187
     188    open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
     189    write (id, '("----- Field ' // name // '",//)')
     190
     191    Dim = shape(Field)
     192    offset = len(trim(int2str(Dim(1)))) + len(trim(int2str(Dim(2)))) + 3
     193    ColumnSize = 20 + 6 + 3 + offset
     194
     195    spacing = '(t2,"' // repeat('-', ColumnSize * NbCol) // '")'
     196
     197    do i = 1, Dim(2)
     198      nb = 0
     199      Pos = 2
     200      do j = 1, Dim(1)
     201        nb = nb + 1
     202
     203        if (MOD(nb, NbCol)==0) then
     204          form = '(t' // trim(int2str(pos)) // &
     205                  ',"(' // trim(int2str(j)) // ','          &
     206                  // trim(int2str(i)) // ')",t'       &
     207                  // trim(int2str(pos + offset))     &
     208                  // '," ---> ",g22.16,/)'
     209          Pos = 2
     210        else
     211          form = '(t' // trim(int2str(pos)) // &
     212                  ',"(' // trim(int2str(j)) // ','          &
     213                  // trim(int2str(i)) // ')",t'       &
     214                  // trim(int2str(pos + offset))     &
     215                  // '," ---> ",g22.16," | ")'
     216          Pos = Pos + ColumnSize
     217        endif
     218        write (id, form, advance = 'no') Field(j, i)
     219      enddo
     220      if (MOD(nb, NbCol)==0) then
     221        write (id, spacing)
     222      else
     223        write (id, '("")')
     224        write (id, spacing)
     225      endif
     226    enddo
     227
     228  end subroutine write_field2D
     229
     230  subroutine write_field3D(name, Field)
     231    implicit none
     232
     233    integer, parameter :: MaxDim = 3
     234    character(len = *) :: name
     235    real, dimension(:, :, :) :: Field
     236    real, dimension(:, :, :), allocatable :: New_Field
     237    integer, dimension(MaxDim) :: Dim
     238    integer :: i, j, k, nb
     239    integer, parameter :: id = 10
     240    integer, parameter :: NbCol = 4
     241    integer :: ColumnSize
     242    integer :: pos, offset
     243    character(len = 255) :: form
     244    character(len = 255) :: spacing
     245
     246    open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
     247    write (id, '("----- Field ' // name // '"//)')
     248
     249    Dim = shape(Field)
     250    offset = len(trim(int2str(Dim(1)))) + len(trim(int2str(Dim(2)))) + len(trim(int2str(Dim(3)))) + 4
     251    ColumnSize = 22 + 6 + 3 + offset
     252
     253    !    open(unit=id,file=name,form=formatted
     254
     255    spacing = '(t2,"' // repeat('-', ColumnSize * NbCol) // '")'
     256
     257    do i = 1, Dim(3)
     258
     259      do j = 1, Dim(2)
     260        nb = 0
     261        Pos = 2
     262
     263        do k = 1, Dim(1)
     264          nb = nb + 1
     265
     266          if (MOD(nb, NbCol)==0) then
     267            form = '(t' // trim(int2str(pos)) // &
     268                    ',"(' // trim(int2str(k)) // ','          &
     269                    // trim(int2str(j)) // ','          &
     270                    // trim(int2str(i)) // ')",t'       &
     271                    // trim(int2str(pos + offset))      &
     272                    // '," ---> ",g22.16,/)'
     273            Pos = 2
     274          else
     275            form = '(t' // trim(int2str(pos)) // &
     276                    ',"(' // trim(int2str(k)) // ','          &
     277                    // trim(int2str(j)) // ','          &
     278                    // trim(int2str(i)) // ')",t'       &
     279                    // trim(int2str(pos + offset))      &
     280                    // '," ---> ",g22.16," | ")'
     281            ! dépend de l'implémention, sur compaq, c'est necessaire
     282            !            Pos=Pos+ColumnSize
     283          endif
     284          write (id, form, advance = 'no') Field(k, j, i)
     285        enddo
     286        if (MOD(nb, NbCol)==0) then
     287          write (id, spacing)
     288        else
     289          write (id, '("")')
     290          write (id, spacing)
    37291        endif
    38292      enddo
    39     end function GetFieldIndex
    40  
    41     subroutine WriteField3d(name,Field)
    42     implicit none
    43       character(len=*) :: name
    44       real, dimension(:,:,:) :: Field
    45       integer, dimension(3) :: Dim
    46      
    47       Dim=shape(Field)
    48       CALL WriteField_gen(name,Field,Dim(1),Dim(2),Dim(3))
    49  
    50     end subroutine WriteField3d
    51    
    52     subroutine WriteField2d(name,Field)
    53     implicit none
    54       character(len=*) :: name
    55       real, dimension(:,:) :: Field
    56       integer, dimension(2) :: Dim
    57      
    58       Dim=shape(Field)
    59       CALL WriteField_gen(name,Field,Dim(1),Dim(2),1)
    60  
    61     end subroutine WriteField2d
    62    
    63     subroutine WriteField1d(name,Field)
    64     implicit none
    65       character(len=*) :: name
    66       real, dimension(:) :: Field
    67       integer, dimension(1) :: Dim
    68      
    69       Dim=shape(Field)
    70       CALL WriteField_gen(name,Field,Dim(1),1,1)
    71  
    72     end subroutine WriteField1d
    73        
    74     subroutine WriteField_gen(name,Field,dimx,dimy,dimz)
    75     implicit none
    76       character(len=*) :: name
    77       integer :: dimx,dimy,dimz
    78       real,dimension(dimx,dimy,dimz) :: Field
    79       integer,dimension(dimx*dimy*dimz) :: ndex
    80       integer :: status
    81       integer :: index
    82       integer :: start(4)
    83       integer :: count(4)
    84      
    85            
    86       Index=GetFieldIndex(name)
    87       if (Index==-1) then
    88         CALL CreateNewField(name,dimx,dimy,dimz)
    89         Index=GetFieldIndex(name)
    90       else
    91         FieldIndex(Index)=FieldIndex(Index)+1.
    92       endif
    93      
    94       start(1)=1
    95       start(2)=1
    96       start(3)=1
    97       start(4)=FieldIndex(Index)
    98 
    99       count(1)=dimx
    100       count(2)=dimy
    101       count(3)=dimz
    102       count(4)=1
    103 
    104       status = nf90_put_var(FieldId(Index),FieldVarId(Index),Field,start,count)
    105       status = nf90_sync(FieldId(Index))
    106      
    107     end subroutine WriteField_gen
    108        
    109     subroutine CreateNewField(name,dimx,dimy,dimz)
    110     implicit none
    111       character(len=*) :: name
    112       integer :: dimx,dimy,dimz
    113       integer :: TabDim(4)
    114       integer :: status
    115      
    116      
    117       NbField=NbField+1
    118       FieldName(NbField)=TRIM(ADJUSTL(name))
    119       FieldIndex(NbField)=1
    120      
    121      
    122       status = nf90_create(TRIM(ADJUSTL(name))//'.nc', nf90_clobber, FieldId(NbField))
    123       status = nf90_def_dim(FieldId(NbField),'X',dimx,TabDim(1))
    124       status = nf90_def_dim(FieldId(NbField),'Y',dimy,TabDim(2))
    125       status = nf90_def_dim(FieldId(NbField),'Z',dimz,TabDim(3))
    126       status = nf90_def_dim(FieldId(NbField),'iter',nf90_unlimited,TabDim(4))
    127       status = nf90_def_var(FieldId(NbField),FieldName(NbField),nf90_format,TabDim,FieldVarId(NbField))
    128       status = nf90_enddef(FieldId(NbField))
    129 
    130     end subroutine CreateNewField
    131    
    132   subroutine write_field1D(name,Field)
    133     implicit none
    134  
    135     integer, parameter :: MaxDim=1
    136     character(len=*)   :: name
    137     real, dimension(:) :: Field
    138     real, dimension(:),allocatable :: New_Field
    139     character(len=20) :: str
    140     integer, dimension(MaxDim) :: Dim
    141     integer :: i,nb
    142     integer, parameter :: id=10
    143     integer, parameter :: NbCol=4
    144     integer :: ColumnSize
    145     integer :: pos
    146     character(len=255) :: form
    147     character(len=255) :: MaxLen
    148    
    149    
    150     open(unit=id,file=name//'.field',form='formatted',status='replace')
    151     write (id,'("----- Field '//name//'",//)')
    152     Dim=shape(Field)
    153     MaxLen=int2str(len(trim(int2str(Dim(1)))))
    154     ColumnSize=20+6+3+len(trim(int2str(Dim(1))))
    155     Nb=0
    156     Pos=2
    157     do i=1,Dim(1)
    158       nb=nb+1
    159      
    160       if (MOD(nb,NbCol)==0) then
    161         form='(t'//trim(int2str(pos))// ',i'//trim(MaxLen) //'," ---> ",g22.16,/)'
    162         Pos=2
    163       else
    164         form='(t'//trim(int2str(pos))// ',i'//trim(MaxLen) //'," ---> ",g22.16," | ",)'
    165         Pos=Pos+ColumnSize
    166       endif
    167       write (id,form,advance='no') i,Field(i)
     293      write (id, spacing)
    168294    enddo
    169      
     295
    170296    close(id)
    171297
    172   end subroutine write_field1D
    173 
    174   subroutine write_field2D(name,Field)
    175     implicit none
    176  
    177     integer, parameter :: MaxDim=2
    178     character(len=*)   :: name
    179     real, dimension(:,:) :: Field
    180     real, dimension(:,:),allocatable :: New_Field
    181     character(len=20) :: str
    182     integer, dimension(MaxDim) :: Dim
    183     integer :: i,j,nb
    184     integer, parameter :: id=10
    185     integer, parameter :: NbCol=4
    186     integer :: ColumnSize
    187     integer :: pos,offset
    188     character(len=255) :: form
    189     character(len=255) :: spacing
    190    
    191     open(unit=id,file=name//'.field',form='formatted',status='replace')
    192     write (id,'("----- Field '//name//'",//)')
    193    
    194     Dim=shape(Field)
    195     offset=len(trim(int2str(Dim(1))))+len(trim(int2str(Dim(2))))+3
    196     ColumnSize=20+6+3+offset
    197 
    198     spacing='(t2,"'//repeat('-',ColumnSize*NbCol)//'")'
    199    
    200     do i=1,Dim(2)
    201       nb=0
    202       Pos=2
    203       do j=1,Dim(1)
    204         nb=nb+1
    205      
    206         if (MOD(nb,NbCol)==0) then
    207           form='(t'//trim(int2str(pos))//            &
    208                ',"('//trim(int2str(j))//','          &
    209                     //trim(int2str(i))//')",t'       &
    210                     //trim(int2str(pos+offset))     &   
    211                     //'," ---> ",g22.16,/)'
    212           Pos=2
    213         else
    214           form='(t'//trim(int2str(pos))//            &
    215                ',"('//trim(int2str(j))//','          &
    216                     //trim(int2str(i))//')",t'       &
    217                     //trim(int2str(pos+offset))     &   
    218                     //'," ---> ",g22.16," | ")'
    219           Pos=Pos+ColumnSize
    220         endif
    221         write (id,form,advance='no') Field(j,i)
    222       enddo
    223       if (MOD(nb,NbCol)==0) then
    224         write (id,spacing)
    225       else
    226         write (id,'("")')
    227         write (id,spacing)
    228       endif
    229     enddo
    230      
    231   end subroutine write_field2D
    232  
    233   subroutine write_field3D(name,Field)
    234     implicit none
    235  
    236     integer, parameter :: MaxDim=3
    237     character(len=*)   :: name
    238     real, dimension(:,:,:) :: Field
    239     real, dimension(:,:,:),allocatable :: New_Field
    240     integer, dimension(MaxDim) :: Dim
    241     integer :: i,j,k,nb
    242     integer, parameter :: id=10
    243     integer, parameter :: NbCol=4
    244     integer :: ColumnSize
    245     integer :: pos,offset
    246     character(len=255) :: form
    247     character(len=255) :: spacing
    248 
    249     open(unit=id,file=name//'.field',form='formatted',status='replace')
    250     write (id,'("----- Field '//name//'"//)')
    251    
    252     Dim=shape(Field)
    253     offset=len(trim(int2str(Dim(1))))+len(trim(int2str(Dim(2))))+len(trim(int2str(Dim(3))))+4
    254     ColumnSize=22+6+3+offset
    255 
    256 !    open(unit=id,file=name,form=formatted
    257    
    258     spacing='(t2,"'//repeat('-',ColumnSize*NbCol)//'")'
    259    
    260     do i=1,Dim(3)
    261    
    262       do j=1,Dim(2)
    263         nb=0
    264         Pos=2
    265        
    266         do k=1,Dim(1)
    267         nb=nb+1
    268      
    269           if (MOD(nb,NbCol)==0) then
    270             form='(t'//trim(int2str(pos))//            &
    271                  ',"('//trim(int2str(k))//','          &
    272                       //trim(int2str(j))//','          &
    273                       //trim(int2str(i))//')",t'       &
    274                       //trim(int2str(pos+offset))      &   
    275                       //'," ---> ",g22.16,/)'
    276            Pos=2
    277           else
    278             form='(t'//trim(int2str(pos))//            &
    279                  ',"('//trim(int2str(k))//','          &
    280                       //trim(int2str(j))//','          &
    281                       //trim(int2str(i))//')",t'       &
    282                       //trim(int2str(pos+offset))      &   
    283                       //'," ---> ",g22.16," | ")'
    284 ! dépend de l'implémention, sur compaq, c'est necessaire
    285 !            Pos=Pos+ColumnSize
    286           endif
    287           write (id,form,advance='no') Field(k,j,i)
    288         enddo
    289         if (MOD(nb,NbCol)==0) then
    290           write (id,spacing)
    291         else
    292           write (id,'("")')
    293           write (id,spacing)
    294         endif
    295       enddo
    296       write (id,spacing)
    297     enddo
    298    
    299     close(id)
    300  
    301   end subroutine write_field3D 
    302  
    303   function int2str(int)
    304     implicit none
    305     integer, parameter :: MaxLen=10
    306     integer,intent(in) :: int
    307     character(len=MaxLen) :: int2str
    308     logical :: flag
    309     integer :: i
    310     flag=.true.
    311    
    312     i=int
    313    
    314     int2str=''
    315     do while (flag)
    316       int2str=CHAR(MOD(i,10)+48)//int2str
    317       i=i/10
    318       if (i==0) flag=.false.
    319     enddo
    320   end function int2str
     298  end subroutine write_field3D
    321299
    322300end module write_field

  • LMDZ6/branches/Amaury_dev/libf/misc/wxios.F90

    r5101 r5103  
    425425            if (ii_end<nbp_lon) mask(ii_end+1:nbp_lon,jj_nb) = .FALSE.
    426426            ! special case for south pole
    427             if ((ii_end==1).and.(is_south_pole_dyn)) mask(1:nbp_lon,jj_nb)=.true.
     427            if ((ii_end==1).and.(is_south_pole_dyn)) mask(1:nbp_lon,jj_nb)=.TRUE.
    428428            IF (prt_level >= 10) THEN
    429429              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
    … …  
    595595              WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
    596596            ENDIF
    597             ! Ehouarn: add an enable=.true. on top of xml definitions... why???
     597            ! Ehouarn: add an enable=.TRUE. on top of xml definitions... why???
    598598            CALL xios_set_file_attr(fname, enabled=.TRUE.)
    599599        END IF
    … …  
    674674        IF (PRESENT(nam_axvert)) THEN
    675675           axis_id=nam_axvert
    676            print*,'nam_axvert=',axis_id
     676           PRINT*,'nam_axvert=',axis_id
    677677        ENDIF
    678678       
    … …  
    748748            !Sinon on se contente de l'activer:
    749749            CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
    750             !NB: This will override an enable=.false. set by a user in the xml file;
     750            !NB: This will override an enable=.FALSE. set by a user in the xml file;
    751751            !   then the only way to not output the field is by changing its
    752752            !   output level

  • LMDZ6/branches/Amaury_dev/libf/misc/xercnt.F

    r5101 r5103  
    3030C      --Input--
    3131C        LIBRAR - the library that the routine is in.
    32 C        SUBROU - the subroutine that XERMSG is being called from
     32C        SUBROU - the SUBROUTINE that XERMSG is being called from
    3333C        MESSG  - the first 20 characters of the error message.
    3434C        NERR   - same as in the CALL to XERMSG.

  • LMDZ6/branches/Amaury_dev/libf/misc/xermsg.F

    r5101 r5103  
    1313C   XERMSG processes a diagnostic message in a manner determined by the
    1414C   value of LEVEL and the current value of the library error control
    15 C   flag, KONTRL.  See subroutine XSETF for details.
     15C   flag, KONTRL.  See SUBROUTINE XSETF for details.
    1616C
    1717C    LIBRAR   A character constant (or character variable) with the name

  • LMDZ6/branches/Amaury_dev/libf/misc/xersve.F

    r5086 r5103  
    2323C
    2424C        LIBRAR :IN    is the library that the message is from.
    25 C        SUBROU :IN    is the subroutine that the message is from.
     25C        SUBROU :IN    is the SUBROUTINE that the message is from.
    2626C        MESSG  :IN    is the message to be saved.
    2727C        KFLAG  :IN    indicates the action to be performed.
Note: See TracChangeset for help on using the changeset viewer.