- Timestamp:
- 2019-12-05T12:06:36+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/DIA/diaharm.F90
r10840 r12065 5 5 !!====================================================================== 6 6 !! History : 3.1 ! 2007 (O. Le Galloudec, J. Chanut) Original code 7 !!----------------------------------------------------------------------8 #if defined key_diaharm9 !!----------------------------------------------------------------------10 !! 'key_diaharm'11 7 !!---------------------------------------------------------------------- 12 8 USE oce ! ocean dynamics and tracers variables … … 26 22 IMPLICIT NONE 27 23 PRIVATE 28 29 LOGICAL, PUBLIC, PARAMETER :: lk_diaharm = .TRUE.30 24 31 25 INTEGER, PARAMETER :: jpincomax = 2.*jpmax_harmo … … 33 27 34 28 ! !!** 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 39 34 40 35 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ana_temp … … 51 46 CHARACTER (LEN=4), DIMENSION(jpmax_harmo) :: tname ! Names of tidal constituents ('M2', 'K1',...) 52 47 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 54 50 55 51 !!---------------------------------------------------------------------- … … 69 65 !! 70 66 !!-------------------------------------------------------------------- 71 INTEGER :: jh, nhan, jk, ji67 INTEGER :: jh, nhan, ji 72 68 INTEGER :: ios ! Local integer output status for namelist read 73 69 TYPE(tide_harmonic), DIMENSION(:), POINTER :: tide_harmonics ! Oscillation parameters of selected tidal components 74 70 75 NAMELIST/nam_diaharm/ nit000_han, nitend_han, nstep_han, tname71 NAMELIST/nam_diaharm/ ln_diaharm, nit000_han, nitend_han, nstep_han, tname 76 72 !!---------------------------------------------------------------------- 77 73 … … 82 78 ENDIF 83 79 ! 84 IF( .NOT. ln_tide ) CALL ctl_stop( 'dia_harm_init : ln_tide must be true for harmonic analysis')85 !86 80 REWIND( numnam_ref ) ! Namelist nam_diaharm in reference namelist : Tidal harmonic analysis 87 81 READ ( numnam_ref, nam_diaharm, IOSTAT = ios, ERR = 901) 88 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diaharm in reference namelist' , lwp)82 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diaharm in reference namelist' ) 89 83 REWIND( numnam_cfg ) ! Namelist nam_diaharm in configuration namelist : Tidal harmonic analysis 90 84 READ ( numnam_cfg, nam_diaharm, IOSTAT = ios, ERR = 902 ) 91 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist' , lwp)85 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist' ) 92 86 IF(lwm) WRITE ( numond, nam_diaharm ) 93 87 ! 94 88 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 98 93 ENDIF 99 94 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 121 140 ENDIF 122 !123 IF (nb_ana > jpmax_harmo) THEN124 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_harmo126 CALL ctl_stop( 'dia_harm_init', ctmp1, ctmp2 )127 ENDIF128 129 IF(lwp) WRITE(numout,*) 'Analysed frequency : ',nb_ana ,'Frequency '130 131 DO jh = 1, nb_ana132 IF(lwp) WRITE(numout,*) ' : ',tname(jh),' ',tide_harmonics(jh)%omega133 END DO134 135 ! Initialize temporary arrays:136 ! ----------------------------137 ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) )138 ana_temp(:,:,:,:) = 0._wp139 141 140 142 END SUBROUTINE dia_harm_init … … 156 158 !!-------------------------------------------------------------------- 157 159 IF( ln_timing ) CALL timing_start('dia_harm') 158 !159 IF( kt == nit000 ) CALL dia_harm_init160 160 ! 161 161 IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN … … 405 405 INTEGER, INTENT(in) :: init 406 406 ! 407 INTEGER :: ji_sd, jj_sd, ji1_sd, ji2_sd, j k1_sd, jk2_sd407 INTEGER :: ji_sd, jj_sd, ji1_sd, ji2_sd, jh1_sd, jh2_sd 408 408 REAL(wp) :: zval1, zval2, zx1 409 409 REAL(wp), DIMENSION(jpincomax) :: ztmpx, zcol1, zcol2 … … 417 417 ztmp3(:,:) = 0._wp 418 418 ! 419 DO j k1_sd = 1, nsparse420 DO j k2_sd = 1, nsparse421 nisparse(j k2_sd) = nisparse(jk2_sd)422 njsparse(j k2_sd) = njsparse(jk2_sd)423 IF( nisparse(j k2_sd) == nisparse(jk1_sd) ) THEN424 ztmp3(njsparse(j k1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) &425 & + valuesparse(j k1_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) 426 426 ENDIF 427 427 END DO … … 498 498 END SUBROUTINE SUR_DETERMINE 499 499 500 #else501 !!----------------------------------------------------------------------502 !! Default case : Empty module503 !!----------------------------------------------------------------------504 LOGICAL, PUBLIC, PARAMETER :: lk_diaharm = .FALSE.505 CONTAINS506 SUBROUTINE dia_harm ( kt ) ! Empty routine507 INTEGER, INTENT( IN ) :: kt508 WRITE(*,*) 'dia_harm: you should not have seen this print'509 END SUBROUTINE dia_harm510 #endif511 512 500 !!====================================================================== 513 501 END MODULE diaharm
Note: See TracChangeset
for help on using the changeset viewer.
