New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12143 for NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/DIA/diadct.F90 – NEMO

Ignore:
Timestamp:
2019-12-10T12:57:49+01:00 (4 years ago)
Author:
mathiot
Message:

update ENHANCE-02_ISF_nemo to 12072 (sette in progress)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/DIA/diadct.F90

    r10425 r12143  
    1111   !!            3.4  ! 09/2011 (C Bricaud) 
    1212   !!---------------------------------------------------------------------- 
    13 #if defined key_diadct 
    14    !!---------------------------------------------------------------------- 
    15    !!   'key_diadct' : 
    16    !!---------------------------------------------------------------------- 
     13   !! does not work with agrif 
     14#if ! defined key_agrif 
    1715   !!---------------------------------------------------------------------- 
    1816   !!   dia_dct      :  Compute the transport through a sec. 
     
    4240 
    4341   PUBLIC   dia_dct      ! routine called by step.F90 
    44    PUBLIC   dia_dct_init ! routine called by opa.F90 
    45    PUBLIC   diadct_alloc ! routine called by nemo_init in nemogcm.F90  
    46    PRIVATE  readsec 
    47    PRIVATE  removepoints 
    48    PRIVATE  transport 
    49    PRIVATE  dia_dct_wri 
    50  
    51    LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .TRUE.   !: model-data diagnostics flag 
    52  
    53    INTEGER :: nn_dct        ! Frequency of computation 
    54    INTEGER :: nn_dctwri     ! Frequency of output 
    55    INTEGER :: nn_secdebug   ! Number of the section to debug 
     42   PUBLIC   dia_dct_init ! routine called by nemogcm.F90 
     43 
     44   !                         !!** namelist variables ** 
     45   LOGICAL, PUBLIC ::   ln_diadct     !: Calculate transport thru a section or not 
     46   INTEGER         ::   nn_dct        !  Frequency of computation 
     47   INTEGER         ::   nn_dctwri     !  Frequency of output 
     48   INTEGER         ::   nn_secdebug   !  Number of the section to debug 
    5649    
    5750   INTEGER, PARAMETER :: nb_class_max  = 10 
     
    10497CONTAINS 
    10598  
    106   INTEGER FUNCTION diadct_alloc()  
    107      !!----------------------------------------------------------------------  
    108      !!                   ***  FUNCTION diadct_alloc  ***  
    109      !!----------------------------------------------------------------------  
    110      INTEGER :: ierr(2)  
    111      !!----------------------------------------------------------------------  
    112  
    113      ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(1) )  
    114      ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max)    , STAT=ierr(2) )  
    115  
    116      diadct_alloc = MAXVAL( ierr )  
    117      IF( diadct_alloc /= 0 )   CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' )  
    118   
    119   END FUNCTION diadct_alloc  
    120  
     99   INTEGER FUNCTION diadct_alloc()  
     100      !!----------------------------------------------------------------------  
     101      !!                   ***  FUNCTION diadct_alloc  ***  
     102      !!----------------------------------------------------------------------  
     103 
     104      ALLOCATE( transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), & 
     105         &      transports_2d(nb_2d_vars,nb_sec_max,nb_point_max)    , STAT=diadct_alloc )  
     106 
     107      CALL mpp_sum( 'diadct', diadct_alloc )  
     108      IF( diadct_alloc /= 0 )   CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' )  
     109 
     110   END FUNCTION diadct_alloc 
    121111 
    122112   SUBROUTINE dia_dct_init 
     
    130120      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    131121      !! 
    132       NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug 
     122      NAMELIST/nam_diadct/ln_diadct, nn_dct, nn_dctwri, nn_secdebug 
    133123      !!--------------------------------------------------------------------- 
    134124 
    135      REWIND( numnam_ref )              ! Namelist namdct in reference namelist : Diagnostic: transport through sections 
    136      READ  ( numnam_ref, namdct, IOSTAT = ios, ERR = 901) 
    137 901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdct in reference namelist', lwp ) 
    138  
    139      REWIND( numnam_cfg )              ! Namelist namdct in configuration namelist : Diagnostic: transport through sections 
    140      READ  ( numnam_cfg, namdct, IOSTAT = ios, ERR = 902 ) 
    141 902  IF( ios >  0 ) CALL ctl_nam ( ios , 'namdct in configuration namelist', lwp ) 
    142      IF(lwm) WRITE ( numond, namdct ) 
     125     REWIND( numnam_ref )              ! Namelist nam_diadct in reference namelist : Diagnostic: transport through sections 
     126     READ  ( numnam_ref, nam_diadct, IOSTAT = ios, ERR = 901) 
     127901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diadct in reference namelist' ) 
     128 
     129     REWIND( numnam_cfg )              ! Namelist nam_diadct in configuration namelist : Diagnostic: transport through sections 
     130     READ  ( numnam_cfg, nam_diadct, IOSTAT = ios, ERR = 902 ) 
     131902  IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_diadct in configuration namelist' ) 
     132     IF(lwm) WRITE ( numond, nam_diadct ) 
    143133 
    144134     IF( lwp ) THEN 
     
    146136        WRITE(numout,*) "diadct_init: compute transports through sections " 
    147137        WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 
    148         WRITE(numout,*) "       Frequency of computation: nn_dct    = ",nn_dct 
    149         WRITE(numout,*) "       Frequency of write:       nn_dctwri = ",nn_dctwri 
     138        WRITE(numout,*) "       Calculate transport thru sections: ln_diadct = ", ln_diadct 
     139        WRITE(numout,*) "       Frequency of computation:          nn_dct    = ", nn_dct 
     140        WRITE(numout,*) "       Frequency of write:                nn_dctwri = ", nn_dctwri 
    150141 
    151142        IF      ( nn_secdebug .GE. 1 .AND. nn_secdebug .LE. nb_sec_max )THEN 
     
    155146        ELSE                              ; WRITE(numout,*)"       Wrong value for nn_secdebug : ",nn_secdebug 
    156147        ENDIF 
    157  
     148     ENDIF 
     149 
     150     IF( ln_diadct ) THEN 
     151        ! control 
    158152        IF(nn_dct .GE. nn_dctwri .AND. MOD(nn_dct,nn_dctwri) .NE. 0)  & 
    159           &  CALL ctl_stop( 'diadct: nn_dct should be smaller and a multiple of nn_dctwri' ) 
    160  
     153           &  CALL ctl_stop( 'diadct: nn_dct should be smaller and a multiple of nn_dctwri' ) 
     154 
     155        ! allocate dia_dct arrays 
     156        IF( diadct_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' ) 
     157 
     158        !Read section_ijglobal.diadct 
     159        CALL readsec 
     160 
     161        !open output file 
     162        IF( lwm ) THEN 
     163           CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
     164           CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
     165           CALL ctl_opn( numdct_salt, 'salt_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
     166        ENDIF 
     167 
     168        ! Initialise arrays to zero  
     169        transports_3d(:,:,:,:)=0.0  
     170        transports_2d(:,:,:)  =0.0  
     171        ! 
    161172     ENDIF 
    162  
    163      !Read section_ijglobal.diadct 
    164      CALL readsec 
    165  
    166      !open output file 
    167      IF( lwm ) THEN 
    168         CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
    169         CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
    170         CALL ctl_opn( numdct_salt, 'salt_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
    171      ENDIF 
    172  
    173      ! Initialise arrays to zero  
    174      transports_3d(:,:,:,:)=0.0  
    175      transports_2d(:,:,:)  =0.0  
    176173     ! 
    177174  END SUBROUTINE dia_dct_init 
     
    12411238#else 
    12421239   !!---------------------------------------------------------------------- 
    1243    !!   Default option :                                       Dummy module 
     1240   !!   Dummy module                                              
    12441241   !!---------------------------------------------------------------------- 
    1245    LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .FALSE.    !: diamht flag 
    1246    PUBLIC  
    1247    !! $Id$ 
     1242   LOGICAL, PUBLIC ::   ln_diadct = .FALSE. 
    12481243CONTAINS 
    1249  
    1250    SUBROUTINE dia_dct_init          ! Dummy routine 
     1244   SUBROUTINE dia_dct_init 
    12511245      IMPLICIT NONE 
    1252       WRITE(*,*) 'dia_dct_init: You should not have seen this print! error?' 
    12531246   END SUBROUTINE dia_dct_init 
    1254  
    1255    SUBROUTINE dia_dct( kt )         ! Dummy routine 
     1247   SUBROUTINE dia_dct( kt ) 
    12561248      IMPLICIT NONE 
    1257       INTEGER, INTENT( in ) :: kt   ! ocean time-step index 
    1258       WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt 
     1249      INTEGER, INTENT(in) ::   kt 
    12591250   END SUBROUTINE dia_dct 
     1251   ! 
    12601252#endif 
    12611253 
Note: See TracChangeset for help on using the changeset viewer.