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 12065 for NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/DIA – NEMO

Ignore:
Timestamp:
2019-12-05T12:06:36+01:00 (5 years ago)
Author:
smueller
Message:

Synchronizing with /NEMO/trunk@12055 (ticket #2194)

Location:
NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/DIA
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/DIA/dia25h.F90

    r10641 r12065  
    5555      REWIND ( numnam_ref )              ! Read Namelist nam_dia25h in reference namelist : 25hour mean diagnostics 
    5656      READ   ( numnam_ref, nam_dia25h, IOSTAT=ios, ERR= 901 ) 
    57 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_dia25h in reference namelist', lwp ) 
     57901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_dia25h in reference namelist' ) 
    5858      REWIND( numnam_cfg )              ! Namelist nam_dia25h in configuration namelist  25hour diagnostics 
    5959      READ  ( numnam_cfg, nam_dia25h, IOSTAT = ios, ERR = 902 ) 
    60 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_dia25h in configuration namelist', lwp ) 
     60902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_dia25h in configuration namelist' ) 
    6161      IF(lwm) WRITE ( numond, nam_dia25h ) 
    6262 

  • NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/DIA/diacfl.F90

    r10425 r12065  
    1717   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    1818   USE in_out_manager  ! I/O manager 
     19   USE iom             !  
    1920   USE timing          ! Performance output 
    2021 
    … …  
    2728   INTEGER, DIMENSION(3) ::   nCu_loc, nCv_loc, nCw_loc   ! U, V, and W run max locations in the global domain 
    2829   REAL(wp)              ::   rCu_max, rCv_max, rCw_max   ! associated run max Courant number  
    29  
    30 !!gm CAUTION: need to declare these arrays here, otherwise the calculation fails in multi-proc ! 
    31 !!gm          I don't understand why. 
    32    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zCu_cfl, zCv_cfl, zCw_cfl         ! workspace 
    33 !!gm end 
    3430 
    3531   PUBLIC   dia_cfl       ! routine called by step.F90 
    … …  
    5450      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    5551      ! 
    56       INTEGER                ::   ji, jj, jk                            ! dummy loop indices 
    57       REAL(wp)               ::   z2dt, zCu_max, zCv_max, zCw_max       ! local scalars 
    58       INTEGER , DIMENSION(3) ::   iloc_u , iloc_v , iloc_w , iloc       ! workspace 
    59 !!gm this does not work      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zCu_cfl, zCv_cfl, zCw_cfl         ! workspace 
     52      INTEGER                          ::   ji, jj, jk                       ! dummy loop indices 
     53      REAL(wp)                         ::   z2dt, zCu_max, zCv_max, zCw_max  ! local scalars 
     54      INTEGER , DIMENSION(3)           ::   iloc_u , iloc_v , iloc_w , iloc  ! workspace 
     55      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zCu_cfl, zCv_cfl, zCw_cfl        ! workspace 
    6056      !!---------------------------------------------------------------------- 
    6157      ! 
    … …  
    7066      DO jk = 1, jpk       ! calculate Courant numbers 
    7167         DO jj = 1, jpj 
    72             DO ji = 1, fs_jpim1   ! vector opt. 
     68            DO ji = 1, jpi 
    7369               zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * z2dt / e1u  (ji,jj)      ! for i-direction 
    7470               zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * z2dt / e2v  (ji,jj)      ! for j-direction 
    … …  
    7874      END DO 
    7975      ! 
     76      ! write outputs 
     77      IF( iom_use('cfl_cu') )   CALL iom_put( 'cfl_cu', MAXVAL( zCu_cfl, dim=3 ) ) 
     78      IF( iom_use('cfl_cv') )   CALL iom_put( 'cfl_cv', MAXVAL( zCv_cfl, dim=3 ) ) 
     79      IF( iom_use('cfl_cw') )   CALL iom_put( 'cfl_cw', MAXVAL( zCw_cfl, dim=3 ) ) 
     80 
    8081      !                    ! calculate maximum values and locations 
    8182      IF( lk_mpp ) THEN 
    … …  
    105106      !                    ! write out to file 
    106107      IF( lwp ) THEN 
    107          WRITE(numcfl,FMT='(2x,i4,5x,a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) 
     108         WRITE(numcfl,FMT='(2x,i6,3x,a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) 
    108109         WRITE(numcfl,FMT='(11x,     a6,4x,f7.4,1x,i4,1x,i4,1x,i4)')     'Max Cv', zCv_max, iloc_v(1), iloc_v(2), iloc_v(3) 
    109110         WRITE(numcfl,FMT='(11x,     a6,4x,f7.4,1x,i4,1x,i4,1x,i4)')     'Max Cw', zCw_max, iloc_w(1), iloc_w(2), iloc_w(3) 
    … …  
    166167      rCw_max = 0._wp 
    167168      ! 
    168 !!gm required to work 
    169       ALLOCATE ( zCu_cfl(jpi,jpj,jpk), zCv_cfl(jpi,jpj,jpk), zCw_cfl(jpi,jpj,jpk) ) 
    170 !!gm end 
    171       !       
    172169   END SUBROUTINE dia_cfl_init 
    173170 

  • NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/DIA/diadct.F90

    r10425 r12065  
    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 

  • NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/DIA/diaharm.F90

    r10840 r12065  
    55   !!====================================================================== 
    66   !! History :  3.1  !  2007  (O. Le Galloudec, J. Chanut)  Original code 
    7    !!---------------------------------------------------------------------- 
    8 #if defined key_diaharm 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_diaharm' 
    117   !!---------------------------------------------------------------------- 
    128   USE oce             ! ocean dynamics and tracers variables 
    … …  
    2622   IMPLICIT NONE 
    2723   PRIVATE 
    28  
    29    LOGICAL, PUBLIC, PARAMETER :: lk_diaharm  = .TRUE. 
    3024    
    3125   INTEGER, PARAMETER :: jpincomax    = 2.*jpmax_harmo 
    … …  
    3327 
    3428   !                         !!** namelist variables ** 
    35    INTEGER ::   nit000_han    ! First time step used for harmonic analysis 
    36    INTEGER ::   nitend_han    ! Last time step used for harmonic analysis 
    37    INTEGER ::   nstep_han     ! Time step frequency for harmonic analysis 
    38    INTEGER ::   nb_ana        ! Number of harmonics to analyse 
     29   LOGICAL, PUBLIC ::   ln_diaharm    ! Choose tidal harmonic output or not 
     30   INTEGER         ::   nit000_han    ! First time step used for harmonic analysis 
     31   INTEGER         ::   nitend_han    ! Last time step used for harmonic analysis 
     32   INTEGER         ::   nstep_han     ! Time step frequency for harmonic analysis 
     33   INTEGER         ::   nb_ana        ! Number of harmonics to analyse 
    3934 
    4035   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ana_temp 
    … …  
    5146   CHARACTER (LEN=4), DIMENSION(jpmax_harmo) ::   tname   ! Names of tidal constituents ('M2', 'K1',...) 
    5247 
    53    PUBLIC   dia_harm   ! routine called by step.F90 
     48   PUBLIC   dia_harm        ! routine called by step.F90 
     49   PUBLIC   dia_harm_init   ! routine called by nemogcm.F90 
    5450 
    5551   !!---------------------------------------------------------------------- 
    … …  
    6965      !! 
    7066      !!-------------------------------------------------------------------- 
    71       INTEGER :: jh, nhan, jk, ji 
     67      INTEGER ::   jh, nhan, ji 
    7268      INTEGER ::   ios                 ! Local integer output status for namelist read 
    7369      TYPE(tide_harmonic), DIMENSION(:), POINTER ::   tide_harmonics  ! Oscillation parameters of selected tidal components 
    7470 
    75       NAMELIST/nam_diaharm/ nit000_han, nitend_han, nstep_han, tname 
     71      NAMELIST/nam_diaharm/ ln_diaharm, nit000_han, nitend_han, nstep_han, tname 
    7672      !!---------------------------------------------------------------------- 
    7773 
    … …  
    8278      ENDIF 
    8379      ! 
    84       IF( .NOT. ln_tide )   CALL ctl_stop( 'dia_harm_init : ln_tide must be true for harmonic analysis') 
    85       ! 
    8680      REWIND( numnam_ref )              ! Namelist nam_diaharm in reference namelist : Tidal harmonic analysis 
    8781      READ  ( numnam_ref, nam_diaharm, IOSTAT = ios, ERR = 901) 
    88 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_diaharm in reference namelist', lwp ) 
     82901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_diaharm in reference namelist' ) 
    8983      REWIND( numnam_cfg )              ! Namelist nam_diaharm in configuration namelist : Tidal harmonic analysis 
    9084      READ  ( numnam_cfg, nam_diaharm, IOSTAT = ios, ERR = 902 ) 
    91 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist', lwp ) 
     85902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist' ) 
    9286      IF(lwm) WRITE ( numond, nam_diaharm ) 
    9387      ! 
    9488      IF(lwp) THEN 
    95          WRITE(numout,*) 'First time step used for analysis:  nit000_han= ', nit000_han 
    96          WRITE(numout,*) 'Last  time step used for analysis:  nitend_han= ', nitend_han 
    97          WRITE(numout,*) 'Time step frequency for harmonic analysis:  nstep_han= ', nstep_han 
     89         WRITE(numout,*) 'Tidal diagnostics = ', ln_diaharm 
     90         WRITE(numout,*) '   First time step used for analysis:         nit000_han= ', nit000_han 
     91         WRITE(numout,*) '   Last  time step used for analysis:         nitend_han= ', nitend_han 
     92         WRITE(numout,*) '   Time step frequency for harmonic analysis: nstep_han = ', nstep_han 
    9893      ENDIF 
    9994 
    100       ! Basic checks on harmonic analysis time window: 
    101       ! ---------------------------------------------- 
    102       IF( nit000 > nit000_han )   CALL ctl_stop( 'dia_harm_init : nit000_han must be greater than nit000',   & 
    103          &                                       ' restart capability not implemented' ) 
    104       IF( nitend < nitend_han )   CALL ctl_stop( 'dia_harm_init : nitend_han must be lower than nitend',   & 
    105          &                                       'restart capability not implemented' ) 
    106  
    107       IF( MOD( nitend_han-nit000_han+1 , nstep_han ) /= 0 )   & 
    108          &                        CALL ctl_stop( 'dia_harm_init : analysis time span must be a multiple of nstep_han' ) 
    109  
    110       ! Initialize oscillation parameters for tidal components that have been 
    111       ! selected for harmonic analysis 
    112       ! --------------------------------------------------------------------- 
    113       CALL tide_init_harmonics(tname, tide_harmonics) 
    114       ! Number of tidal components selected for harmonic analysis 
    115       nb_ana = size(tide_harmonics) 
    116       ! 
    117       IF(lwp) THEN 
    118          WRITE(numout,*) '        Namelist nam_diaharm' 
    119          WRITE(numout,*) '        nb_ana    = ', nb_ana 
    120          CALL flush(numout) 
     95      IF( ln_diaharm .AND. .NOT.ln_tide )   CALL ctl_stop( 'dia_harm_init : ln_tide must be true for harmonic analysis') 
     96 
     97      IF( ln_diaharm ) THEN 
     98 
     99         ! 
     100         ! Basic checks on harmonic analysis time window: 
     101         ! ---------------------------------------------- 
     102         IF( nit000 > nit000_han )   CALL ctl_stop( 'dia_harm_init : nit000_han must be greater than nit000',   & 
     103            &                                       ' restart capability not implemented' ) 
     104         IF( nitend < nitend_han )   CALL ctl_stop( 'dia_harm_init : nitend_han must be lower than nitend',   & 
     105            &                                       'restart capability not implemented' ) 
     106 
     107         IF( MOD( nitend_han-nit000_han+1 , nstep_han ) /= 0 )   & 
     108            &                        CALL ctl_stop( 'dia_harm_init : analysis time span must be a multiple of nstep_han' ) 
     109         ! 
     110         ! Initialize oscillation parameters for tidal components that have been 
     111         ! selected for harmonic analysis 
     112         ! --------------------------------------------------------------------- 
     113         CALL tide_init_harmonics(tname, tide_harmonics) 
     114         ! Number of tidal components selected for harmonic analysis 
     115         nb_ana = size(tide_harmonics) 
     116         ! 
     117         IF(lwp) THEN 
     118            WRITE(numout,*) '        Namelist nam_diaharm' 
     119            WRITE(numout,*) '        nb_ana    = ', nb_ana 
     120            CALL flush(numout) 
     121         ENDIF 
     122         ! 
     123         IF (nb_ana > jpmax_harmo) THEN 
     124            WRITE(ctmp1,*) ' nb_ana must be lower than jpmax_harmo' 
     125            WRITE(ctmp2,*) ' jpmax_harmo= ', jpmax_harmo 
     126            CALL ctl_stop( 'dia_harm_init', ctmp1, ctmp2 ) 
     127         ENDIF 
     128 
     129         IF(lwp) WRITE(numout,*) 'Analysed frequency  : ',nb_ana ,'Frequency ' 
     130 
     131         DO jh = 1, nb_ana 
     132            IF(lwp) WRITE(numout,*) '                    : ',tname(jh),' ',tide_harmonics(jh)%omega 
     133         END DO 
     134 
     135         ! Initialize temporary arrays: 
     136         ! ---------------------------- 
     137         ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) ) 
     138         ana_temp(:,:,:,:) = 0._wp 
     139 
    121140      ENDIF 
    122       ! 
    123       IF (nb_ana > jpmax_harmo) THEN 
    124          WRITE(ctmp1,*) ' E R R O R dia_harm_init : nb_ana must be lower than jpmax_harmo, stop' 
    125          WRITE(ctmp2,*) ' jpmax_harmo= ', jpmax_harmo 
    126          CALL ctl_stop( 'dia_harm_init', ctmp1, ctmp2 ) 
    127       ENDIF 
    128  
    129       IF(lwp) WRITE(numout,*) 'Analysed frequency  : ',nb_ana ,'Frequency ' 
    130  
    131       DO jh = 1, nb_ana 
    132         IF(lwp) WRITE(numout,*) '                    : ',tname(jh),' ',tide_harmonics(jh)%omega 
    133       END DO 
    134  
    135       ! Initialize temporary arrays: 
    136       ! ---------------------------- 
    137       ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) ) 
    138       ana_temp(:,:,:,:) = 0._wp 
    139141 
    140142   END SUBROUTINE dia_harm_init 
    … …  
    156158      !!-------------------------------------------------------------------- 
    157159      IF( ln_timing )   CALL timing_start('dia_harm') 
    158       ! 
    159       IF( kt == nit000 )   CALL dia_harm_init 
    160160      ! 
    161161      IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN 
    … …  
    405405      INTEGER, INTENT(in) ::   init  
    406406      ! 
    407       INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd 
     407      INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jh1_sd, jh2_sd 
    408408      REAL(wp)                        :: zval1, zval2, zx1 
    409409      REAL(wp), DIMENSION(jpincomax) :: ztmpx, zcol1, zcol2 
    … …  
    417417         ztmp3(:,:) = 0._wp 
    418418         ! 
    419          DO jk1_sd = 1, nsparse 
    420             DO jk2_sd = 1, nsparse 
    421                nisparse(jk2_sd) = nisparse(jk2_sd) 
    422                njsparse(jk2_sd) = njsparse(jk2_sd) 
    423                IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN 
    424                   ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd))  & 
    425                      &                                     + valuesparse(jk1_sd)*valuesparse(jk2_sd) 
     419         DO jh1_sd = 1, nsparse 
     420            DO jh2_sd = 1, nsparse 
     421               nisparse(jh2_sd) = nisparse(jh2_sd) 
     422               njsparse(jh2_sd) = njsparse(jh2_sd) 
     423               IF( nisparse(jh2_sd) == nisparse(jh1_sd) ) THEN 
     424                  ztmp3(njsparse(jh1_sd),njsparse(jh2_sd)) = ztmp3(njsparse(jh1_sd),njsparse(jh2_sd))  & 
     425                     &                                     + valuesparse(jh1_sd)*valuesparse(jh2_sd) 
    426426               ENDIF 
    427427            END DO 
    … …  
    498498   END SUBROUTINE SUR_DETERMINE 
    499499 
    500 #else 
    501    !!---------------------------------------------------------------------- 
    502    !!   Default case :   Empty module 
    503    !!---------------------------------------------------------------------- 
    504    LOGICAL, PUBLIC, PARAMETER ::   lk_diaharm = .FALSE. 
    505 CONTAINS 
    506    SUBROUTINE dia_harm ( kt )     ! Empty routine 
    507       INTEGER, INTENT( IN ) :: kt   
    508       WRITE(*,*) 'dia_harm: you should not have seen this print' 
    509    END SUBROUTINE dia_harm 
    510 #endif 
    511  
    512500   !!====================================================================== 
    513501END MODULE diaharm 

  • NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/DIA/diahsb.F90

    r10425 r12065  
    362362      REWIND( numnam_ref )              ! Namelist namhsb in reference namelist 
    363363      READ  ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) 
    364 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namhsb in reference namelist', lwp ) 
     364901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namhsb in reference namelist' ) 
    365365      REWIND( numnam_cfg )              ! Namelist namhsb in configuration namelist 
    366366      READ  ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 
    367 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 
     367902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namhsb in configuration namelist' ) 
    368368      IF(lwm) WRITE( numond, namhsb ) 
    369369 

  • NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/DIA/diaptr.F90

    r10425 r12065  
    393393      REWIND( numnam_ref )              ! Namelist namptr in reference namelist : Poleward transport 
    394394      READ  ( numnam_ref, namptr, IOSTAT = ios, ERR = 901) 
    395 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in reference namelist', lwp ) 
     395901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in reference namelist' ) 
    396396 
    397397      REWIND( numnam_cfg )              ! Namelist namptr in configuration namelist : Poleward transport 
    398398      READ  ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 ) 
    399 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist', lwp ) 
     399902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist' ) 
    400400      IF(lwm) WRITE ( numond, namptr ) 
    401401 

  • NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/DIA/diatmb.F90

    r10499 r12065  
    4343      REWIND( numnam_ref )              ! Read Namelist nam_diatmb in reference namelist : TMB diagnostics 
    4444      READ  ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 ) 
    45 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist', lwp ) 
     45901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist' ) 
    4646  
    4747      REWIND( numnam_cfg )              ! Namelist nam_diatmb in configuration namelist  TMB diagnostics 
    4848      READ  ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 ) 
    49 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist', lwp ) 
     49902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist' ) 
    5050      IF(lwm) WRITE ( numond, nam_diatmb ) 
    5151 

  • NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/DIA/diawri.F90

    r10425 r12065  
    210210      ENDIF 
    211211 
     212      IF( ln_zad_Aimp ) wn = wn + wi               ! Recombine explicit and implicit parts of vertical velocity for diagnostic output 
     213      ! 
    212214      CALL iom_put( "woce", wn )                   ! vertical velocity 
    213215      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    … …  
    220222         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 
    221223      ENDIF 
     224      ! 
     225      IF( ln_zad_Aimp ) wn = wn - wi               ! Remove implicit part of vertical velocity that was added for diagnostic output 
    222226 
    223227      CALL iom_put( "avt" , avt )                  ! T vert. eddy diff. coef. 
    … …  
    426430      !!      define all the NETCDF files and fields 
    427431      !!      At each time step call histdef to compute the mean if ncessary 
    428       !!      Each nwrite time step, output the instantaneous or mean fields 
     432      !!      Each nn_write time step, output the instantaneous or mean fields 
    429433      !!---------------------------------------------------------------------- 
    430434      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    … …  
    442446      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d       ! 3D workspace 
    443447      !!---------------------------------------------------------------------- 
    444       !  
    445       IF( ln_timing )   CALL timing_start('dia_wri') 
    446448      ! 
    447449      IF( ninist == 1 ) THEN     !==  Output the initial state and forcings  ==! 
    … …  
    450452      ENDIF 
    451453      ! 
     454      IF( nn_write == -1 )   RETURN   ! we will never do any output 
     455      !  
     456      IF( ln_timing )   CALL timing_start('dia_wri') 
     457      ! 
    452458      ! 0. Initialisation 
    453459      ! ----------------- 
    … …  
    459465      clop = "x"         ! no use of the mask value (require less cpu time and otherwise the model crashes) 
    460466#if defined key_diainstant 
    461       zsto = nwrite * rdt 
     467      zsto = nn_write * rdt 
    462468      clop = "inst("//TRIM(clop)//")" 
    463469#else 
    … …  
    465471      clop = "ave("//TRIM(clop)//")" 
    466472#endif 
    467       zout = nwrite * rdt 
     473      zout = nn_write * rdt 
    468474      zmax = ( nitend - nit000 + 1 ) * rdt 
    469475 
    … …  
    496502         ! WRITE root name in date.file for use by postpro 
    497503         IF(lwp) THEN 
    498             CALL dia_nam( clhstnam, nwrite,' ' ) 
     504            CALL dia_nam( clhstnam, nn_write,' ' ) 
    499505            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    500506            WRITE(inum,*) clhstnam 
    … …  
    504510         ! Define the T grid FILE ( nid_T ) 
    505511 
    506          CALL dia_nam( clhstnam, nwrite, 'grid_T' ) 
     512         CALL dia_nam( clhstnam, nn_write, 'grid_T' ) 
    507513         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename 
    508514         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
    … …  
    540546         ! Define the U grid FILE ( nid_U ) 
    541547 
    542          CALL dia_nam( clhstnam, nwrite, 'grid_U' ) 
     548         CALL dia_nam( clhstnam, nn_write, 'grid_U' ) 
    543549         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename 
    544550         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu 
    … …  
    553559         ! Define the V grid FILE ( nid_V ) 
    554560 
    555          CALL dia_nam( clhstnam, nwrite, 'grid_V' )                   ! filename 
     561         CALL dia_nam( clhstnam, nn_write, 'grid_V' )                   ! filename 
    556562         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam 
    557563         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv 
    … …  
    566572         ! Define the W grid FILE ( nid_W ) 
    567573 
    568          CALL dia_nam( clhstnam, nwrite, 'grid_W' )                   ! filename 
     574         CALL dia_nam( clhstnam, nn_write, 'grid_W' )                   ! filename 
    569575         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam 
    570576         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
    … …  
    657663         ENDIF 
    658664 
    659          IF( .NOT. ln_cpl ) THEN 
     665         IF( ln_ssr ) THEN 
    660666            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    661667               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    665671               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    666672         ENDIF 
    667  
    668          IF( ln_cpl .AND. nn_ice <= 1 ) THEN 
    669             CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    670                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    671             CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    672                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    673             CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
    674                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    675          ENDIF 
    676           
     673        
    677674         clmx ="l_max(only(x))"    ! max index on a period 
    678675!         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX  
    … …  
    750747      ! donne le nombre d'elements, et ndex la liste des indices a sortir 
    751748 
    752       IF( lwp .AND. MOD( itmod, nwrite ) == 0 ) THEN  
     749      IF( lwp .AND. MOD( itmod, nn_write ) == 0 ) THEN  
    753750         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step' 
    754751         WRITE(numout,*) '~~~~~~ ' 
    … …  
    814811      ENDIF 
    815812 
    816       IF( .NOT. ln_cpl ) THEN 
     813      IF( ln_ssr ) THEN 
    817814         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    818815         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    819          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    820          CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    821       ENDIF 
    822       IF( ln_cpl .AND. nn_ice <= 1 ) THEN 
    823          CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    824          CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    825          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     816         zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    826817         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    827818      ENDIF 
    … …  
    842833      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress 
    843834 
    844       CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current 
     835      IF( ln_zad_Aimp ) THEN 
     836         CALL histwrite( nid_W, "vovecrtz", it, wn + wi     , ndim_T, ndex_T )    ! vert. current 
     837      ELSE 
     838         CALL histwrite( nid_W, "vovecrtz", it, wn          , ndim_T, ndex_T )    ! vert. current 
     839      ENDIF 
    845840      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef. 
    846841      CALL histwrite( nid_W, "votkeavm", it, avm            , ndim_T, ndex_T )    ! T vert. eddy visc. coef. 
    … …  
    903898      CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity 
    904899      CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity 
    905       CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity 
     900      IF( ln_zad_Aimp ) THEN 
     901         CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn + wi        )    ! now k-velocity 
     902      ELSE 
     903         CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn             )    ! now k-velocity 
     904      ENDIF 
    906905      IF( ALLOCATED(ahtu) ) THEN 
    907906         CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point 
Note: See TracChangeset for help on using the changeset viewer.