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 3247 – NEMO

Changeset 3247


Ignore:
Timestamp:
2012-01-04T16:59:04+01:00 (12 years ago)
Author:
cbricaud
Message:

correction for diaharm.F90: see ticket 901

Location:
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/AMM12/EXP00/namelist

    r3220 r3247  
    857857    nitend_han = 75        ! Last time step used for harmonic analysis 
    858858    nstep_han  = 15        ! Time step frequency for harmonic analysis 
    859     nb_ana     = 2         ! Number of harmonics to analyse 
    860859    tname(1)   = 'M2'      ! Name of tidal constituents 
    861860    tname(2)   = 'K1' 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist

    r3220 r3247  
    857857    nitend_han = 75        ! Last time step used for harmonic analysis 
    858858    nstep_han  = 15        ! Time step frequency for harmonic analysis 
    859     nb_ana     = 2         ! Number of harmonics to analyse 
    860859    tname(1)   = 'M2'      ! Name of tidal constituents 
    861860    tname(2)   = 'K1' 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist

    r3220 r3247  
    852852    nitend_han = 75        ! Last time step used for harmonic analysis 
    853853    nstep_han  = 15        ! Time step frequency for harmonic analysis 
    854     nb_ana     = 2         ! Number of harmonics to analyse 
    855854    tname(1)   = 'M2'      ! Name of tidal constituents 
    856855    tname(2)   = 'K1' 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    r3186 r3247  
    2525   PRIVATE 
    2626 
    27    LOGICAL, PUBLIC, PARAMETER ::   lk_diaharm  = .TRUE. 
     27   LOGICAL, PUBLIC, PARAMETER :: lk_diaharm  = .TRUE. 
    2828    
    29    INTEGER, PARAMETER :: nb_harmo_max =  9 
    30    INTEGER, PARAMETER :: jpincomax    = 18 
     29   INTEGER, PARAMETER :: jpincomax    = 2.*jpmax_harmo 
    3130   INTEGER, PARAMETER :: jpdimsparse  = jpincomax*300*24 
    3231 
     
    3433                         nit000_han = 1, & ! First time step used for harmonic analysis 
    3534                         nitend_han = 1, & ! Last time step used for harmonic analysis 
    36                          nstep_han  = 1  & ! Time step frequency for harmonic analysis 
     35                         nstep_han  = 1, & ! Time step frequency for harmonic analysis 
    3736                         nb_ana            ! Number of harmonics to analyse 
    3837 
     
    4443                                                out_v 
    4544 
     45   INTEGER :: ninco, nsparse 
    4646   INTEGER ,       DIMENSION(jpdimsparse)         :: njsparse, nisparse 
    4747   INTEGER , SAVE, DIMENSION(jpincomax)           :: ipos1 
     
    5151   REAL(wp), SAVE, DIMENSION(jpincomax)           :: zpivot 
    5252 
    53    CHARACTER (LEN=4), DIMENSION(nb_harmo_max) ::   & 
     53   CHARACTER (LEN=4), DIMENSION(jpmax_harmo) ::   & 
    5454       tname         ! Names of tidal constituents ('M2', 'K1',...) 
    5555 
     
    7878      !! * Local declarations  
    7979      INTEGER :: jh, nhan, jk, ji 
    80       NAMELIST/nam_diaharm/ nit000_han, nitend_han, nstep_han, nb_ana, tname 
    81  
    82       !!---------------------------------------------------------------------- 
    83  
    84       ! Read namelist parameters: 
    85       ! ------------------------- 
     80 
     81      NAMELIST/nam_diaharm/ nit000_han, nitend_han, nstep_han, tname 
     82      !!---------------------------------------------------------------------- 
     83 
     84      IF(lwp) THEN 
     85         WRITE(numout,*) 
     86         WRITE(numout,*) 'dia_harm_init: Tidal harmonic analysis initialization' 
     87         WRITE(numout,*) '~~~~~~~ ' 
     88      ENDIF 
     89      ! 
     90      CALL tide_init_Wave 
     91      ! 
     92      tname(:)='' 
     93      ! 
     94      ! Read Namelist nam_diaharm 
    8695      REWIND ( numnam ) 
    8796      READ   ( numnam, nam_diaharm ) 
    88  
    89       IF(lwp) WRITE(numout,*) 
    90       IF(lwp) WRITE(numout,*) 'dia_harm_init: Tidal harmonic analysis initialization' 
    91       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 
    92  
    93       IF(lwp) WRITE(numout,*) 'First time step used for analysis:  nit000_han= ', nit000_han 
    94       IF(lwp) WRITE(numout,*) 'Last  time step used for analysis:  nitend_han= ', nitend_han 
    95       IF(lwp) WRITE(numout,*) 'Time step frequency for harmonic analysis:  nstep_han= ', nstep_han 
    96  
    97       IF (nb_ana > nb_harmo_max) THEN 
    98         IF(lwp) WRITE(numout,*) ' E R R O R : dia_harm_init. & 
    99                                 & nb_ana must be lower than nb_harmo_max, stop' 
    100         IF(lwp) WRITE(numout,*) 'nb_harmo_max= ', nb_harmo_max 
    101         nstop = nstop + 1 
     97      ! 
     98      IF(lwp) THEN 
     99         WRITE(numout,*) 'First time step used for analysis:  nit000_han= ', nit000_han 
     100         WRITE(numout,*) 'Last  time step used for analysis:  nitend_han= ', nitend_han 
     101         WRITE(numout,*) 'Time step frequency for harmonic analysis:  nstep_han= ', nstep_han 
    102102      ENDIF 
    103103 
     
    105105      ! ---------------------------------------------- 
    106106      IF (nit000 > nit000_han) THEN 
    107         IF(lwp) WRITE(numout,*) ' E R R O R : dia_harm_init. & 
    108                                 & nit000_han must be greater than nit000, stop' 
    109         IF(lwp) WRITE(numout,*) 'restart capability not implemented' 
     107        IF(lwp) WRITE(numout,*) ' E R R O R dia_harm_init : nit000_han must be greater than nit000, stop' 
     108        IF(lwp) WRITE(numout,*) ' restart capability not implemented' 
    110109        nstop = nstop + 1 
    111110      ENDIF 
    112111      IF (nitend < nitend_han) THEN 
    113         IF(lwp) WRITE(numout,*) ' E R R O R : dia_harm_init. & 
    114                                 & nitend_han must be lower than nitend, stop' 
    115         IF(lwp) WRITE(numout,*) 'restart capability not implemented' 
     112        IF(lwp) WRITE(numout,*) ' E R R O R dia_harm_init : nitend_han must be lower than nitend, stop' 
     113        IF(lwp) WRITE(numout,*) ' restart capability not implemented' 
    116114        nstop = nstop + 1 
    117115      ENDIF 
    118116 
    119117      IF (MOD(nitend_han-nit000_han+1,nstep_han).NE.0) THEN 
    120         IF(lwp) WRITE(numout,*) ' E R R O R : dia_harm_init. & 
    121                                 & analysis time span must be a multiple of nstep_han, stop' 
     118        IF(lwp) WRITE(numout,*) ' E R R O R dia_harm_init : analysis time span must be a multiple of nstep_han, stop' 
    122119        nstop = nstop + 1 
    123120      END IF 
    124121 
    125       CALL tide_init_Wave 
     122      nb_ana=0 
     123      DO jk=1,jpmax_harmo 
     124         DO ji=1,jpmax_harmo 
     125            IF(TRIM(tname(jk)) == Wave(ji)%cname_tide) THEN 
     126               nb_ana=nb_ana+1 
     127            ENDIF 
     128         END DO 
     129      ENDDO 
     130      ! 
     131      IF(lwp) THEN 
     132         WRITE(numout,*) '        Namelist nam_diaharm' 
     133         WRITE(numout,*) '        nb_ana    = ', nb_ana 
     134         CALL flush(numout) 
     135      ENDIF 
     136      ! 
     137      IF (nb_ana > jpmax_harmo) THEN 
     138        IF(lwp) WRITE(numout,*) ' E R R O R dia_harm_init : nb_ana must be lower than jpmax_harmo, stop' 
     139        IF(lwp) WRITE(numout,*) ' jpmax_harmo= ', jpmax_harmo 
     140        nstop = nstop + 1 
     141      ENDIF 
    126142 
    127143      ALLOCATE(name    (nb_ana)) 
     
    183199           (MOD(kt,nstep_han).EQ.0) ) THEN 
    184200 
    185         ztime = kt*rdt  
     201        ztime = (kt-nit000+1)*rdt  
    186202        
    187203        nhc = 0 
     
    239255      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ana_amp 
    240256      !!-------------------------------------------------------------------- 
    241       CALL wrk_alloc( jpi , jpj , nb_harmo_max , 2 , ana_amp ) 
     257      CALL wrk_alloc( jpi , jpj , jpmax_harmo , 2 , ana_amp ) 
    242258 
    243259      IF(lwp) WRITE(numout,*) 
     
    280296               DO jc = 1,2 
    281297                  kun = kun + 1 
    282                   tmp4(kun)=ana_temp(ji,jj,kun,1) 
     298                  ztmp4(kun)=ana_temp(ji,jj,kun,1) 
    283299               ENDDO 
    284300            ENDDO 
     
    288304            ! Fill output array 
    289305            DO jh = 1, nb_ana 
    290                ana_amp(ji,jj,jh,1)=tmp7((jh-1)*2+1) 
    291                ana_amp(ji,jj,jh,2)=tmp7((jh-1)*2+2) 
     306               ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1) 
     307               ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2) 
    292308            END DO 
    293309         END DO 
     
    317333               DO jc = 1,2 
    318334                  kun = kun + 1 
    319                   tmp4(kun)=ana_temp(ji,jj,kun,2) 
     335                  ztmp4(kun)=ana_temp(ji,jj,kun,2) 
    320336               ENDDO 
    321337            ENDDO 
     
    325341            ! Fill output array 
    326342            DO jh = 1, nb_ana 
    327                ana_amp(ji,jj,jh,1)=tmp7((jh-1)*2+1) 
    328                ana_amp(ji,jj,jh,2)=tmp7((jh-1)*2+2) 
     343               ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1) 
     344               ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2) 
    329345            END DO 
    330346 
     
    351367               DO jc = 1,2 
    352368                  kun = kun + 1 
    353                   tmp4(kun)=ana_temp(ji,jj,kun,3) 
     369                  ztmp4(kun)=ana_temp(ji,jj,kun,3) 
    354370               ENDDO 
    355371            ENDDO 
     
    359375            ! Fill output array 
    360376            DO jh = 1, nb_ana 
    361                ana_amp(ji,jj,jh,1)=tmp7((jh-1)*2+1) 
    362                ana_amp(ji,jj,jh,2)=tmp7((jh-1)*2+2) 
     377               ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1) 
     378               ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2) 
    363379            END DO 
    364380 
     
    378394 
    379395      CALL dia_wri_harm ! Write results in files 
    380  
    381       CALL wrk_dealloc( jpi , jpj , nb_harmo_max , 2 , ana_amp ) 
    382   END SUBROUTINE dia_harm_end 
    383  
    384   SUBROUTINE dia_wri_harm 
     396      CALL wrk_dealloc( jpi , jpj , jpmax_harmo , 2 , ana_amp ) 
     397      ! 
     398   END SUBROUTINE dia_harm_end 
     399 
     400   SUBROUTINE dia_wri_harm 
    385401      !!-------------------------------------------------------------------- 
    386402      !!                 ***  ROUTINE dia_wri_harm  *** 
     
    397413      CHARACTER(LEN=lc) :: cltext 
    398414      CHARACTER(LEN=lc) ::   & 
    399          cdfile_name_T    ,   & ! name of the file created (T-points) 
    400          cdfile_name_U    ,   & ! name of the file created (U-points) 
    401          cdfile_name_V          ! name of the file created (V-points) 
    402       INTEGER  ::   jh        
     415         cdfile_name_T   ,   & ! name of the file created (T-points) 
     416         cdfile_name_U   ,   & ! name of the file created (U-points) 
     417         cdfile_name_V         ! name of the file created (V-points) 
     418      INTEGER  ::   jh 
    403419      !!---------------------------------------------------------------------- 
    404420 
     
    410426 
    411427      IF(lwp) WRITE(numout,*) '  ' 
    412       IF(lwp) WRITE(numout,*) 'dia_wri_harm : Write harmonic analysis results'  
     428      IF(lwp) WRITE(numout,*) 'dia_wri_harm : Write harmonic analysis results' 
    413429#if defined key_dimgout 
    414430      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~  Output files: ', TRIM(cdfile_name_T) 
     
    457473#endif 
    458474 
    459   END SUBROUTINE dia_wri_harm 
     475   END SUBROUTINE dia_wri_harm 
    460476 
    461477   SUBROUTINE SUR_DETERMINE(init) 
Note: See TracChangeset for help on using the changeset viewer.