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 11692 for NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/DIA/diaharm.F90 – NEMO

Ignore:
Timestamp:
2019-10-12T16:08:18+02:00 (4 years ago)
Author:
francesca
Message:

Update branch to integrate the development starting from the current v4.01 ready trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/DIA/diaharm.F90

    r10835 r11692  
    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   INTEGER , ALLOCATABLE, DIMENSION(:)       ::   name 
     
    5348   CHARACTER (LEN=4), DIMENSION(jpmax_harmo) ::   tname   ! Names of tidal constituents ('M2', 'K1',...) 
    5449 
    55    PUBLIC   dia_harm   ! routine called by step.F90 
     50   PUBLIC   dia_harm        ! routine called by step.F90 
     51   PUBLIC   dia_harm_init   ! routine called by nemogcm.F90 
    5652 
    5753   !!---------------------------------------------------------------------- 
     
    7167      !! 
    7268      !!-------------------------------------------------------------------- 
    73       INTEGER :: jh, nhan, jk, ji 
     69      INTEGER ::   jh, nhan, ji 
    7470      INTEGER ::   ios                 ! Local integer output status for namelist read 
    7571 
    76       NAMELIST/nam_diaharm/ nit000_han, nitend_han, nstep_han, tname 
     72      NAMELIST/nam_diaharm/ ln_diaharm, nit000_han, nitend_han, nstep_han, tname 
    7773      !!---------------------------------------------------------------------- 
    7874 
     
    8379      ENDIF 
    8480      ! 
    85       IF( .NOT. ln_tide )   CALL ctl_stop( 'dia_harm_init : ln_tide must be true for harmonic analysis') 
    86       ! 
    87       CALL tide_init_Wave 
    88       ! 
    8981      REWIND( numnam_ref )              ! Namelist nam_diaharm in reference namelist : Tidal harmonic analysis 
    9082      READ  ( numnam_ref, nam_diaharm, IOSTAT = ios, ERR = 901) 
    91 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_diaharm in reference namelist', lwp ) 
     83901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_diaharm in reference namelist' ) 
    9284      REWIND( numnam_cfg )              ! Namelist nam_diaharm in configuration namelist : Tidal harmonic analysis 
    9385      READ  ( numnam_cfg, nam_diaharm, IOSTAT = ios, ERR = 902 ) 
    94 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist', lwp ) 
     86902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist' ) 
    9587      IF(lwm) WRITE ( numond, nam_diaharm ) 
    9688      ! 
    9789      IF(lwp) THEN 
    98          WRITE(numout,*) 'First time step used for analysis:  nit000_han= ', nit000_han 
    99          WRITE(numout,*) 'Last  time step used for analysis:  nitend_han= ', nitend_han 
    100          WRITE(numout,*) 'Time step frequency for harmonic analysis:  nstep_han= ', nstep_han 
     90         WRITE(numout,*) 'Tidal diagnostics = ', ln_diaharm 
     91         WRITE(numout,*) '   First time step used for analysis:         nit000_han= ', nit000_han 
     92         WRITE(numout,*) '   Last  time step used for analysis:         nitend_han= ', nitend_han 
     93         WRITE(numout,*) '   Time step frequency for harmonic analysis: nstep_han = ', nstep_han 
    10194      ENDIF 
    10295 
    103       ! Basic checks on harmonic analysis time window: 
    104       ! ---------------------------------------------- 
    105       IF( nit000 > nit000_han )   CALL ctl_stop( 'dia_harm_init : nit000_han must be greater than nit000',   & 
    106          &                                       ' restart capability not implemented' ) 
    107       IF( nitend < nitend_han )   CALL ctl_stop( 'dia_harm_init : nitend_han must be lower than nitend',   & 
    108          &                                       'restart capability not implemented' ) 
    109  
    110       IF( MOD( nitend_han-nit000_han+1 , nstep_han ) /= 0 )   & 
    111          &                        CALL ctl_stop( 'dia_harm_init : analysis time span must be a multiple of nstep_han' ) 
    112  
    113       nb_ana = 0 
    114       DO jk=1,jpmax_harmo 
    115          DO ji=1,jpmax_harmo 
    116             IF(TRIM(tname(jk)) == Wave(ji)%cname_tide) THEN 
    117                nb_ana=nb_ana+1 
    118             ENDIF 
    119          END DO 
    120       END DO 
    121       ! 
    122       IF(lwp) THEN 
    123          WRITE(numout,*) '        Namelist nam_diaharm' 
    124          WRITE(numout,*) '        nb_ana    = ', nb_ana 
    125          CALL flush(numout) 
     96      IF( ln_diaharm .AND. .NOT.ln_tide )   CALL ctl_stop( 'dia_harm_init : ln_tide must be true for harmonic analysis') 
     97 
     98      IF( ln_diaharm ) THEN 
     99 
     100         CALL tide_init_Wave 
     101         ! 
     102         ! Basic checks on harmonic analysis time window: 
     103         ! ---------------------------------------------- 
     104         IF( nit000 > nit000_han )   CALL ctl_stop( 'dia_harm_init : nit000_han must be greater than nit000',   & 
     105            &                                       ' restart capability not implemented' ) 
     106         IF( nitend < nitend_han )   CALL ctl_stop( 'dia_harm_init : nitend_han must be lower than nitend',   & 
     107            &                                       'restart capability not implemented' ) 
     108 
     109         IF( MOD( nitend_han-nit000_han+1 , nstep_han ) /= 0 )   & 
     110            &                        CALL ctl_stop( 'dia_harm_init : analysis time span must be a multiple of nstep_han' ) 
     111         ! 
     112         nb_ana = 0 
     113         DO jh=1,jpmax_harmo 
     114            DO ji=1,jpmax_harmo 
     115               IF(TRIM(tname(jh)) == Wave(ji)%cname_tide) THEN 
     116                  nb_ana=nb_ana+1 
     117               ENDIF 
     118            END DO 
     119         END DO 
     120         ! 
     121         IF(lwp) THEN 
     122            WRITE(numout,*) '        Namelist nam_diaharm' 
     123            WRITE(numout,*) '        nb_ana    = ', nb_ana 
     124            CALL flush(numout) 
     125         ENDIF 
     126         ! 
     127         IF (nb_ana > jpmax_harmo) THEN 
     128            WRITE(ctmp1,*) ' nb_ana must be lower than jpmax_harmo' 
     129            WRITE(ctmp2,*) ' jpmax_harmo= ', jpmax_harmo 
     130            CALL ctl_stop( 'dia_harm_init', ctmp1, ctmp2 ) 
     131         ENDIF 
     132 
     133         ALLOCATE(name    (nb_ana)) 
     134         DO jh=1,nb_ana 
     135            DO ji=1,jpmax_harmo 
     136               IF (TRIM(tname(jh)) ==  Wave(ji)%cname_tide) THEN 
     137                  name(jh) = ji 
     138                  EXIT 
     139               END IF 
     140            END DO 
     141         END DO 
     142 
     143         ! Initialize frequency array: 
     144         ! --------------------------- 
     145         ALLOCATE( ana_freq(nb_ana), ut(nb_ana), vt(nb_ana), ft(nb_ana) ) 
     146 
     147         CALL tide_harmo( ana_freq, vt, ut, ft, name, nb_ana ) 
     148 
     149         IF(lwp) WRITE(numout,*) 'Analysed frequency  : ',nb_ana ,'Frequency ' 
     150 
     151         DO jh = 1, nb_ana 
     152            IF(lwp) WRITE(numout,*) '                    : ',tname(jh),' ',ana_freq(jh) 
     153         END DO 
     154 
     155         ! Initialize temporary arrays: 
     156         ! ---------------------------- 
     157         ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) ) 
     158         ana_temp(:,:,:,:) = 0._wp 
     159 
    126160      ENDIF 
    127       ! 
    128       IF (nb_ana > jpmax_harmo) THEN 
    129          WRITE(ctmp1,*) ' nb_ana must be lower than jpmax_harmo' 
    130          WRITE(ctmp2,*) ' jpmax_harmo= ', jpmax_harmo 
    131          CALL ctl_stop( 'dia_harm_init', ctmp1, ctmp2 ) 
    132       ENDIF 
    133  
    134       ALLOCATE(name    (nb_ana)) 
    135       DO jk=1,nb_ana 
    136        DO ji=1,jpmax_harmo 
    137           IF (TRIM(tname(jk)) ==  Wave(ji)%cname_tide) THEN 
    138              name(jk) = ji 
    139              EXIT 
    140           END IF 
    141        END DO 
    142       END DO 
    143  
    144       ! Initialize frequency array: 
    145       ! --------------------------- 
    146       ALLOCATE( ana_freq(nb_ana), ut(nb_ana), vt(nb_ana), ft(nb_ana) ) 
    147  
    148       CALL tide_harmo( ana_freq, vt, ut, ft, name, nb_ana ) 
    149  
    150       IF(lwp) WRITE(numout,*) 'Analysed frequency  : ',nb_ana ,'Frequency ' 
    151  
    152       DO jh = 1, nb_ana 
    153         IF(lwp) WRITE(numout,*) '                    : ',tname(jh),' ',ana_freq(jh) 
    154       END DO 
    155  
    156       ! Initialize temporary arrays: 
    157       ! ---------------------------- 
    158       ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) ) 
    159       ana_temp(:,:,:,:) = 0._wp 
    160161 
    161162   END SUBROUTINE dia_harm_init 
     
    177178      !!-------------------------------------------------------------------- 
    178179      IF( ln_timing )   CALL timing_start('dia_harm') 
    179       ! 
    180       IF( kt == nit000 )   CALL dia_harm_init 
    181180      ! 
    182181      IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN 
     
    422421      INTEGER, INTENT(in) ::   init  
    423422      ! 
    424       INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd 
     423      INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jh1_sd, jh2_sd 
    425424      REAL(wp)                        :: zval1, zval2, zx1 
    426425      REAL(wp), DIMENSION(jpincomax) :: ztmpx, zcol1, zcol2 
     
    434433         ztmp3(:,:) = 0._wp 
    435434         ! 
    436          DO jk1_sd = 1, nsparse 
    437             DO jk2_sd = 1, nsparse 
    438                nisparse(jk2_sd) = nisparse(jk2_sd) 
    439                njsparse(jk2_sd) = njsparse(jk2_sd) 
    440                IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN 
    441                   ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd))  & 
    442                      &                                     + valuesparse(jk1_sd)*valuesparse(jk2_sd) 
     435         DO jh1_sd = 1, nsparse 
     436            DO jh2_sd = 1, nsparse 
     437               nisparse(jh2_sd) = nisparse(jh2_sd) 
     438               njsparse(jh2_sd) = njsparse(jh2_sd) 
     439               IF( nisparse(jh2_sd) == nisparse(jh1_sd) ) THEN 
     440                  ztmp3(njsparse(jh1_sd),njsparse(jh2_sd)) = ztmp3(njsparse(jh1_sd),njsparse(jh2_sd))  & 
     441                     &                                     + valuesparse(jh1_sd)*valuesparse(jh2_sd) 
    443442               ENDIF 
    444443            END DO 
     
    515514   END SUBROUTINE SUR_DETERMINE 
    516515 
    517 #else 
    518    !!---------------------------------------------------------------------- 
    519    !!   Default case :   Empty module 
    520    !!---------------------------------------------------------------------- 
    521    LOGICAL, PUBLIC, PARAMETER ::   lk_diaharm = .FALSE. 
    522 CONTAINS 
    523    SUBROUTINE dia_harm ( kt )     ! Empty routine 
    524       INTEGER, INTENT( IN ) :: kt   
    525       WRITE(*,*) 'dia_harm: you should not have seen this print' 
    526    END SUBROUTINE dia_harm 
    527 #endif 
    528  
    529516   !!====================================================================== 
    530517END MODULE diaharm 
Note: See TracChangeset for help on using the changeset viewer.