Changeset 3160


Ignore:
Timestamp:
Dec 19, 2023, 10:02:23 AM (11 months ago)
Author:
jbclement
Message:

Mars PCM:
Fixed an issue where the gfortran compilation failed due to rank mismatch of the 'field' argument when calling 'writediagfi' + cleaning of the subroutine.
JBC

Location:
trunk/LMDZ.MARS
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.MARS/changelog.txt

    r3158 r3160  
    44074407== 13/12/2023 == CS
    44084408Cleaning of conduction.F, euvheat.F90, moldiff.F and molvis.F, some commented lines referring to a local calculation of layers/levels altitudes have been removed.
     4409
     4410== 19/12/2023 == JBC
     4411Fixed an issue where the gfortran compilation failed due to rank mismatch of the 'field' argument when calling 'writediagfi' + cleaning of the subroutine.

  • trunk/LMDZ.MARS/libf/phymars/write_output_mod.F90

    r3092 r3160  
    11MODULE write_output_mod
    22
    3 IMPLICIT NONE
    4 
    5 PRIVATE
     3implicit none
     4
     5private
    66
    77INTERFACE write_output
    … …  
    1111END INTERFACE write_output
    1212
    13 PUBLIC write_output
    14 
    15 !----------------------------------------------------------------------
    16 CONTAINS
    17 !----------------------------------------------------------------------
    18 
    19   SUBROUTINE write_output_d0(field_name,title,units,field)
    20   ! For a surface field
     13public write_output
     14
     15!-----------------------------------------------------------------------
     16contains
     17!-----------------------------------------------------------------------
     18
     19SUBROUTINE write_output_d0(field_name,title,units,field)
     20! For a surface field
     21
     22#ifdef CPP_XIOS
     23    use xios_output_mod, only: xios_is_active_field
     24    use xios_output_mod, only: send_xios_field
     25#endif
     26
     27implicit none
     28
     29include "dimensions.h"
     30
     31integer, parameter :: ngrid = 2 + (jjm - 1)*iim - 1/jjm
     32character(*), intent(in) :: field_name
     33character(*), intent(in) :: title
     34character(*), intent(in) :: units
     35real,         intent(in) :: field
     36
     37call writediagfi(ngrid,field_name,title,units,0,(/field/))
     38#ifdef CPP_XIOS
     39    ! only send the field to xios if the user asked for it
     40    if (xios_is_active_field(field_name)) call send_xios_field(field_name,(/field/))
     41#endif
     42
     43END SUBROUTINE write_output_d0
     44
     45!-----------------------------------------------------------------------
     46
     47SUBROUTINE write_output_d1(field_name,title,units,field)
     48! For a surface field
     49
    2150#ifdef CPP_XIOS
    2251  use xios_output_mod, only: xios_is_active_field
    2352  use xios_output_mod, only: send_xios_field
    2453#endif
    25   IMPLICIT NONE
    26   include "dimensions.h"
    27   INTEGER ngrid
    28   PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
    29   CHARACTER(LEN=*),INTENT(IN)    :: field_name
    30   CHARACTER(LEN=*),INTENT(IN)    :: title
    31   CHARACTER(LEN=*),INTENT(IN)    :: units
    32   REAL,INTENT(IN)                :: field
    33 
    34   call writediagfi(ngrid,field_name,title,units,0,field)
    35 #ifdef CPP_XIOS
    36   if (xios_is_active_field(field_name)) then
    37     ! only send the field to xios if the user asked for it
    38     call send_xios_field(field_name,field)
    39   endif
    40 #endif
    41 
    42   END SUBROUTINE write_output_d0
    43 
    44 !----------------------------------------------------------------------
    45 
    46   SUBROUTINE write_output_d1(field_name,title,units,field)
    47   ! For a surface field
    48 #ifdef CPP_XIOS
    49   use xios_output_mod, only: xios_is_active_field
    50   use xios_output_mod, only: send_xios_field
    51 #endif
    52   IMPLICIT NONE
    53   include "dimensions.h"
    54   INTEGER ngrid
    55   PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
    56   CHARACTER(LEN=*),INTENT(IN)    :: field_name
    57   CHARACTER(LEN=*),INTENT(IN)    :: title
    58   CHARACTER(LEN=*),INTENT(IN)    :: units
    59   REAL,INTENT(IN)                :: field(:)
    60 
    61   call writediagfi(ngrid,field_name,title,units,2,field)
    62 #ifdef CPP_XIOS
    63   if (xios_is_active_field(field_name)) then
    64     ! only send the field to xios if the user asked for it
    65     call send_xios_field(field_name,field)
    66   endif
    67 #endif
    68 
    69   END SUBROUTINE write_output_d1
    70 
    71 !----------------------------------------------------------------------
    72 
    73   SUBROUTINE write_output_d2(field_name,title,units,field)
    74   ! For a "3D" horizontal-vertical field
    75 #ifdef CPP_XIOS
    76   use xios_output_mod, only: xios_is_active_field
    77   use xios_output_mod, only: send_xios_field
    78 #endif
    79   use comsoil_h, only: nsoilmx
    80   use writediagsoil_mod, only: writediagsoil
    81   IMPLICIT NONE
    82   include "dimensions.h"
    83   INTEGER ngrid
    84   PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
    85   CHARACTER(LEN=*),INTENT(IN)    :: field_name
    86   CHARACTER(LEN=*),INTENT(IN)    :: title
    87   CHARACTER(LEN=*),INTENT(IN)    :: units
    88   REAL,INTENT(IN)                :: field(:,:)
    89 
    90   if(size(field(:,:),2).eq.nsoilmx) then
     54
     55implicit none
     56
     57include "dimensions.h"
     58
     59integer, parameter :: ngrid = 2 + (jjm - 1)*iim - 1/jjm
     60character(*),       intent(in) :: field_name
     61character(*),       intent(in) :: title
     62character(*),       intent(in) :: units
     63real, dimension(:), intent(in) :: field
     64
     65call writediagfi(ngrid,field_name,title,units,2,field)
     66#ifdef CPP_XIOS
     67    ! only send the field to xios if the user asked for it
     68    if (xios_is_active_field(field_name)) call send_xios_field(field_name,field)
     69#endif
     70
     71END SUBROUTINE write_output_d1
     72
     73!-----------------------------------------------------------------------
     74
     75SUBROUTINE write_output_d2(field_name,title,units,field)
     76! For a "3D" horizontal-vertical field
     77
     78#ifdef CPP_XIOS
     79    use xios_output_mod, only: xios_is_active_field
     80    use xios_output_mod, only: send_xios_field
     81#endif
     82use comsoil_h,         only: nsoilmx
     83use writediagsoil_mod, only: writediagsoil
     84
     85implicit none
     86
     87include "dimensions.h"
     88
     89integer, parameter :: ngrid = 2 + (jjm - 1)*iim - 1/jjm
     90character(*),         intent(in) :: field_name
     91character(*),         intent(in) :: title
     92character(*),         intent(in) :: units
     93real, dimension(:,:), intent(in) :: field
     94
     95if (size(field,2) == nsoilmx) then
    9196    call writediagsoil(ngrid,field_name,title,units,3,field)
    92   else
    93     call writediagfi(ngrid,field_name,title,units,3,field(:,:))
    94   endif
    95 #ifdef CPP_XIOS
    96   if (xios_is_active_field(field_name)) then
    97     ! only send the field to xios if the user asked for it
    98     call send_xios_field(field_name,field)
    99   endif
    100 #endif
    101 
    102   END SUBROUTINE write_output_d2
    103 
    104 !----------------------------------------------------------------------
    105 
    106   SUBROUTINE write_output_i0(field_name,title,units,field)
    107   ! For a surface field
    108 #ifdef CPP_XIOS
    109   use xios_output_mod, only: xios_is_active_field
    110   use xios_output_mod, only: send_xios_field
    111 #endif
    112   IMPLICIT NONE
    113   include "dimensions.h"
    114   INTEGER ngrid
    115   PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
    116   CHARACTER(LEN=*),INTENT(IN)    :: field_name
    117   CHARACTER(LEN=*),INTENT(IN)    :: title
    118   CHARACTER(LEN=*),INTENT(IN)    :: units
    119   INTEGER,INTENT(IN)             :: field
    120 
    121   call writediagfi(ngrid,field_name,title,units,0,real(field))
    122 #ifdef CPP_XIOS
    123   if (xios_is_active_field(field_name)) then
    124     ! only send the field to xios if the user asked for it
    125     call send_xios_field(field_name,real(field))
    126   endif
    127 #endif
    128 
    129   END SUBROUTINE write_output_i0
    130 
    131 !----------------------------------------------------------------------
    132 
    133   SUBROUTINE write_output_i1(field_name,title,units,field)
    134   ! For a surface field
    135 #ifdef CPP_XIOS
    136   use xios_output_mod, only: xios_is_active_field
    137   use xios_output_mod, only: send_xios_field
    138 #endif
    139   IMPLICIT NONE
    140   include "dimensions.h"
    141   INTEGER ngrid
    142   PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
    143   CHARACTER(LEN=*),INTENT(IN)    :: field_name
    144   CHARACTER(LEN=*),INTENT(IN)    :: title
    145   CHARACTER(LEN=*),INTENT(IN)    :: units
    146   INTEGER,INTENT(IN)             :: field(:)
    147 
    148   call writediagfi(ngrid,field_name,title,units,2,real(field))
    149 #ifdef CPP_XIOS
    150   if (xios_is_active_field(field_name)) then
    151     ! only send the field to xios if the user asked for it
    152     call send_xios_field(field_name,real(field))
    153   endif
    154 #endif
    155 
    156   END SUBROUTINE write_output_i1
    157 
    158 !----------------------------------------------------------------------
    159 
    160   SUBROUTINE write_output_i2(field_name,title,units,field)
    161   ! For a "3D" horizontal-vertical field
    162 #ifdef CPP_XIOS
    163   use xios_output_mod, only: xios_is_active_field
    164   use xios_output_mod, only: send_xios_field
    165 #endif
    166   use comsoil_h, only: nsoilmx
    167   use writediagsoil_mod, only: writediagsoil
    168   IMPLICIT NONE
    169   include "dimensions.h"
    170   INTEGER ngrid
    171   PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
    172   CHARACTER(LEN=*),INTENT(IN)    :: field_name
    173   CHARACTER(LEN=*),INTENT(IN)    :: title
    174   CHARACTER(LEN=*),INTENT(IN)    :: units
    175   INTEGER,INTENT(IN)             :: field(:,:)
    176 
    177   if(size(field(:,:),2).eq.nsoilmx) then
     97else
     98    call writediagfi(ngrid,field_name,title,units,3,field)
     99endif
     100
     101#ifdef CPP_XIOS
     102    ! only send the field to xios if the user asked for it
     103    if (xios_is_active_field(field_name)) call send_xios_field(field_name,field)
     104#endif
     105
     106END SUBROUTINE write_output_d2
     107
     108!-----------------------------------------------------------------------
     109
     110SUBROUTINE write_output_i0(field_name,title,units,field)
     111! For a surface field
     112
     113#ifdef CPP_XIOS
     114    use xios_output_mod, only: xios_is_active_field
     115    use xios_output_mod, only: send_xios_field
     116#endif
     117
     118implicit none
     119
     120include "dimensions.h"
     121
     122integer, parameter :: ngrid = 2 + (jjm - 1)*iim - 1/jjm
     123character(*), intent(in) :: field_name
     124character(*), intent(in) :: title
     125character(*), intent(in) :: units
     126integer,      intent(in) :: field
     127
     128call writediagfi(ngrid,field_name,title,units,0,(/real(field)/))
     129#ifdef CPP_XIOS
     130    ! only send the field to xios if the user asked for it
     131    if (xios_is_active_field(field_name)) call send_xios_field(field_name,(/real(field)/))
     132#endif
     133
     134END SUBROUTINE write_output_i0
     135
     136!-----------------------------------------------------------------------
     137
     138SUBROUTINE write_output_i1(field_name,title,units,field)
     139! For a surface field
     140
     141#ifdef CPP_XIOS
     142    use xios_output_mod, only: xios_is_active_field
     143    use xios_output_mod, only: send_xios_field
     144#endif
     145
     146implicit none
     147
     148include "dimensions.h"
     149
     150integer, parameter :: ngrid = 2 + (jjm - 1)*iim - 1/jjm
     151character(*),          intent(in) :: field_name
     152character(*),          intent(in) :: title
     153character(*),          intent(in) :: units
     154integer, dimension(:), intent(in) :: field
     155
     156call writediagfi(ngrid,field_name,title,units,2,real(field))
     157#ifdef CPP_XIOS
     158    ! only send the field to xios if the user asked for it
     159    if (xios_is_active_field(field_name)) call send_xios_field(field_name,real(field))
     160#endif
     161
     162END SUBROUTINE write_output_i1
     163
     164!-----------------------------------------------------------------------
     165
     166SUBROUTINE write_output_i2(field_name,title,units,field)
     167! For a "3D" horizontal-vertical field
     168
     169#ifdef CPP_XIOS
     170    use xios_output_mod, only: xios_is_active_field
     171    use xios_output_mod, only: send_xios_field
     172#endif
     173
     174use comsoil_h,         only: nsoilmx
     175use writediagsoil_mod, only: writediagsoil
     176
     177implicit none
     178
     179include "dimensions.h"
     180
     181integer, parameter :: ngrid = 2 + (jjm - 1)*iim - 1/jjm
     182character(*),            intent(in) :: field_name
     183character(*),            intent(in) :: title
     184character(*),            intent(in) :: units
     185integer, dimension(:,:), intent(in) :: field
     186
     187if (size(field,2) == nsoilmx) then
    178188    call writediagsoil(ngrid,field_name,title,units,3,real(field))
    179   else
    180     call writediagfi(ngrid,field_name,title,units,3,real(field(:,:)))
    181   endif
    182 #ifdef CPP_XIOS
    183   if (xios_is_active_field(field_name)) then
    184     ! only send the field to xios if the user asked for it
    185     call send_xios_field(field_name,real(field))
    186   endif
    187 #endif
    188 
    189   END SUBROUTINE write_output_i2
    190 
    191 !----------------------------------------------------------------------
    192 
    193   SUBROUTINE write_output_l0(field_name,title,units,field)
    194   ! For a surface field
    195 #ifdef CPP_XIOS
    196   use xios_output_mod, only: xios_is_active_field
    197   use xios_output_mod, only: send_xios_field
    198 #endif
    199   IMPLICIT NONE
    200   include "dimensions.h"
    201   INTEGER ngrid
    202   PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
    203   CHARACTER(LEN=*),INTENT(IN)    :: field_name
    204   CHARACTER(LEN=*),INTENT(IN)    :: title
    205   CHARACTER(LEN=*),INTENT(IN)    :: units
    206   LOGICAL,INTENT(IN)             :: field
     189else
     190    call writediagfi(ngrid,field_name,title,units,3,real(field))
     191endif
     192#ifdef CPP_XIOS
     193    ! only send the field to xios if the user asked for it
     194    if (xios_is_active_field(field_name)) call send_xios_field(field_name,real(field))
     195#endif
     196
     197END SUBROUTINE write_output_i2
     198
     199!-----------------------------------------------------------------------
     200
     201SUBROUTINE write_output_l0(field_name,title,units,field)
     202 ! For a surface field
     203 
     204#ifdef CPP_XIOS
     205    use xios_output_mod, only: xios_is_active_field
     206    use xios_output_mod, only: send_xios_field
     207#endif
     208
     209implicit none
     210
     211include "dimensions.h"
     212
     213integer, parameter :: ngrid = 2 + (jjm - 1)*iim - 1/jjm
     214character(*), intent(in) :: field_name
     215character(*), intent(in) :: title
     216character(*), intent(in) :: units
     217logical,      intent(in) :: field
     218! Local argument used to convert logical to real array
     219real, dimension(1) :: field_real
     220
     221field_real = 0.
     222if (field) field_real = 1.
     223
     224call writediagfi(ngrid,field_name,title,units,0,field_real)
     225#ifdef CPP_XIOS
     226    ! only send the field to xios if the user asked for it
     227    if (xios_is_active_field(field_name)) call send_xios_field(field_name,field_real)
     228#endif
     229
     230END SUBROUTINE write_output_l0
     231
     232!-----------------------------------------------------------------------
     233
     234SUBROUTINE write_output_l1(field_name,title,units,field)
     235! For a surface field
     236
     237#ifdef CPP_XIOS
     238    use xios_output_mod, only: xios_is_active_field
     239    use xios_output_mod, only: send_xios_field
     240#endif
     241
     242implicit none
     243
     244include "dimensions.h"
     245
     246integer, parameter :: ngrid = 2 + (jjm - 1)*iim - 1/jjm
     247character(*),          intent(in) :: field_name
     248character(*),          intent(in) :: title
     249character(*),          intent(in) :: units
     250logical, dimension(:), intent(in) :: field
    207251! Local argument used to convert logical to real
    208   REAL                           :: field_real
    209 
    210   field_real=0
    211   if(field) field_real=1
    212 
    213   call writediagfi(ngrid,field_name,title,units,0,field_real)
    214 #ifdef CPP_XIOS
    215   if (xios_is_active_field(field_name)) then
    216     ! only send the field to xios if the user asked for it
    217     call send_xios_field(field_name,field_real)
    218   endif
    219 #endif
    220 
    221   END SUBROUTINE write_output_l0
    222 
    223 !----------------------------------------------------------------------
    224 
    225   SUBROUTINE write_output_l1(field_name,title,units,field)
    226   ! For a surface field
    227 #ifdef CPP_XIOS
    228   use xios_output_mod, only: xios_is_active_field
    229   use xios_output_mod, only: send_xios_field
    230 #endif
    231   IMPLICIT NONE
    232   include "dimensions.h"
    233   INTEGER ngrid
    234   PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
    235   CHARACTER(LEN=*),INTENT(IN)    :: field_name
    236   CHARACTER(LEN=*),INTENT(IN)    :: title
    237   CHARACTER(LEN=*),INTENT(IN)    :: units
    238   LOGICAL,INTENT(IN)             :: field(:)
     252real, dimension(ngrid) :: field_real
     253
     254field_real = 0.
     255where (field) field_real = 1.
     256
     257call writediagfi(ngrid,field_name,title,units,2,field_real)
     258#ifdef CPP_XIOS
     259    ! only send the field to xios if the user asked for it
     260    if (xios_is_active_field(field_name)) call send_xios_field(field_name,field_real)
     261#endif
     262
     263END SUBROUTINE write_output_l1
     264
     265!-----------------------------------------------------------------------
     266
     267SUBROUTINE write_output_l2(field_name,title,units,field)
     268! For a "3D" horizontal-vertical field
     269
     270#ifdef CPP_XIOS
     271    use xios_output_mod, only: xios_is_active_field
     272    use xios_output_mod, only: send_xios_field
     273#endif
     274
     275use comsoil_h,         only: nsoilmx
     276use writediagsoil_mod, only: writediagsoil
     277
     278implicit none
     279
     280include "dimensions.h"
     281
     282integer, parameter :: ngrid = 2 + (jjm - 1)*iim - 1/jjm
     283character(*),            intent(in) :: field_name
     284character(*),            intent(in) :: title
     285character(*),            intent(in) :: units
     286logical, dimension(:,:), intent(in) :: field
    239287! Local argument used to convert logical to real
    240   REAL                           :: field_real(ngrid)
    241   INTEGER                        :: i
    242 
    243   field_real(:)=0.
    244   DO i=1,ngrid
    245     if(field(i)) field_real(i)=1.
    246   ENDDO
    247 
    248   call writediagfi(ngrid,field_name,title,units,2,field_real(:))
    249 #ifdef CPP_XIOS
    250   if (xios_is_active_field(field_name)) then
    251     ! only send the field to xios if the user asked for it
    252     call send_xios_field(field_name,field_real)
    253   endif
    254 #endif
    255 
    256   END SUBROUTINE write_output_l1
    257 
    258 !----------------------------------------------------------------------
    259 
    260   SUBROUTINE write_output_l2(field_name,title,units,field)
    261   ! For a "3D" horizontal-vertical field
    262 #ifdef CPP_XIOS
    263   use xios_output_mod, only: xios_is_active_field
    264   use xios_output_mod, only: send_xios_field
    265 #endif
    266   use comsoil_h, only: nsoilmx
    267   use writediagsoil_mod, only: writediagsoil
    268   IMPLICIT NONE
    269   include "dimensions.h"
    270   INTEGER ngrid
    271   PARAMETER( ngrid = 2+(jjm-1)*iim - 1/jjm   )
    272   CHARACTER(LEN=*),INTENT(IN)    :: field_name
    273   CHARACTER(LEN=*),INTENT(IN)    :: title
    274   CHARACTER(LEN=*),INTENT(IN)    :: units
    275   LOGICAL,INTENT(IN)             :: field(:,:)
    276 ! Local argument used to convert logical to real
    277   REAL,allocatable               :: field_real(:,:)
    278   INTEGER                        :: i,j
    279 
    280   allocate(field_real(size(field,1),size(field,2)))
    281 
    282   field_real(:,:)=0.
    283   DO i=1,size(field,1)
    284     DO j=1,size(field,2)
    285       if(field(i,j)) field_real(i,j)=1.
    286     ENDDO
    287   ENDDO
    288 
    289   if(size(field(:,:),2).eq.nsoilmx) then
     288real, allocatable, dimension(:,:) :: field_real
     289
     290allocate(field_real(size(field,1),size(field,2)))
     291field_real = 0.
     292where (field) field_real = 1.
     293
     294if (size(field,2) == nsoilmx) then
    290295    call writediagsoil(ngrid,field_name,title,units,3,field_real)
    291   else
    292     call writediagfi(ngrid,field_name,title,units,3,field_real(:,:))
    293   endif
    294 
    295 #ifdef CPP_XIOS
    296   if (xios_is_active_field(field_name)) then
    297     ! only send the field to xios if the user asked for it
    298     call send_xios_field(field_name,field_real)
    299   endif
    300 #endif
    301 
    302   deallocate(field_real)
    303 
    304   END SUBROUTINE write_output_l2
     296else
     297    call writediagfi(ngrid,field_name,title,units,3,field_real)
     298endif
     299
     300#ifdef CPP_XIOS
     301    ! only send the field to xios if the user asked for it
     302    if (xios_is_active_field(field_name)) call send_xios_field(field_name,field_real)
     303#endif
     304
     305deallocate(field_real)
     306
     307END SUBROUTINE write_output_l2
    305308
    306309END MODULE write_output_mod
Note: See TracChangeset for help on using the changeset viewer.