- Timestamp:
- 2017-12-01T18:44:09+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r7753 r8882 17 17 USE phycst ! physical constants 18 18 USE sbc_oce ! surface boundary condition: ocean 19 USE sbc_ice , ONLY : snwice_mass, snwice_mass_b 19 20 USE sbcapr ! surface boundary condition: atmospheric pressure 20 21 USE dynspg_exp ! surface pressure gradient (dyn_spg_exp routine) … … 28 29 USE in_out_manager ! I/O manager 29 30 USE lib_mpp ! MPP library 30 USE wrk_nemo ! Memory Allocation31 31 USE timing ! Timing 32 32 … … 47 47 # include "vectopt_loop_substitute.h90" 48 48 !!---------------------------------------------------------------------- 49 !! NEMO/OPA 3.2 , LODYC-IPSL (2009)49 !! NEMO/OPA 4.0 , LODYC-IPSL (2017) 50 50 !! $Id$ 51 51 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 71 71 !! period is used to prevent the divergence of odd and even time step. 72 72 !!---------------------------------------------------------------------- 73 INTEGER, INTENT(in ) :: kt! ocean time-step index74 ! 75 INTEGER :: ji, jj, jk 76 REAL(wp) :: z2dt, zg_2, zintp, zgrau0r ! temporary scalar77 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv78 REAL(wp), POINTER, DIMENSION(:,:) :: zpice79 !!---------------------------------------------------------------------- 80 ! 81 IF( nn_timing == 1 )CALL timing_start('dyn_spg')73 INTEGER, INTENT(in) :: kt ! ocean time-step index 74 ! 75 INTEGER :: ji, jj, jk ! dummy loop indices 76 REAL(wp) :: z2dt, zg_2, zintp, zgrau0r ! local scalars 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpice 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv 79 !!---------------------------------------------------------------------- 80 ! 81 IF( ln_timing ) CALL timing_start('dyn_spg') 82 82 ! 83 83 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 84 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv)84 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 85 85 ztrdu(:,:,:) = ua(:,:,:) 86 86 ztrdv(:,:,:) = va(:,:,:) … … 89 89 IF( ln_apr_dyn & ! atmos. pressure 90 90 .OR. ( .NOT.ln_dynspg_ts .AND. (ln_tide_pot .AND. ln_tide) ) & ! tide potential (no time slitting) 91 .OR. nn_ice_embd == 2 ) THEN! embedded sea-ice91 .OR. ln_ice_embd ) THEN ! embedded sea-ice 92 92 ! 93 93 DO jj = 2, jpjm1 … … 103 103 DO ji = fs_2, fs_jpim1 ! vector opt. 104 104 spgu(ji,jj) = spgu(ji,jj) + zg_2 * ( ssh_ib (ji+1,jj) - ssh_ib (ji,jj) & 105 & + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj)105 & + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) 106 106 spgv(ji,jj) = spgv(ji,jj) + zg_2 * ( ssh_ib (ji,jj+1) - ssh_ib (ji,jj) & 107 & + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj)107 & + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj) 108 108 END DO 109 109 END DO … … 123 123 ENDIF 124 124 ! 125 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 126 CALL wrk_alloc( jpi,jpj, zpice ) 127 ! 125 IF( ln_ice_embd ) THEN !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 126 ALLOCATE( zpice(jpi,jpj) ) 128 127 zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 129 128 zgrau0r = - grav * r1_rau0 … … 135 134 END DO 136 135 END DO 137 ! 138 CALL wrk_dealloc( jpi,jpj, zpice ) 136 DEALLOCATE( zpice ) 139 137 ENDIF 140 138 ! … … 161 159 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 162 160 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 163 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )161 DEALLOCATE( ztrdu , ztrdv ) 164 162 ENDIF 165 163 ! ! print mean trends (used for debugging) … … 167 165 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 168 166 ! 169 IF( nn_timing == 1 )CALL timing_stop('dyn_spg')167 IF( ln_timing ) CALL timing_stop('dyn_spg') 170 168 ! 171 169 END SUBROUTINE dyn_spg … … 186 184 !!---------------------------------------------------------------------- 187 185 ! 188 IF( nn_timing == 1 )CALL timing_start('dyn_spg_init')186 IF( ln_timing ) CALL timing_start('dyn_spg_init') 189 187 ! 190 188 REWIND( numnam_ref ) ! Namelist namdyn_spg in reference namelist : Free surface … … 227 225 ENDIF 228 226 ! 229 IF( nn_timing == 1 )CALL timing_stop('dyn_spg_init')227 IF( ln_timing ) CALL timing_stop('dyn_spg_init') 230 228 ! 231 229 END SUBROUTINE dyn_spg_init
Note: See TracChangeset
for help on using the changeset viewer.