Changeset 14062 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/tests/WAD/MY_SRC/usrdef_istate.F90
- Timestamp:
- 2020-12-03T17:39:30+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/tests/WAD/MY_SRC/usrdef_istate.F90
r13295 r14062 7 7 !! User defined : set the initial state of a user configuration 8 8 !!====================================================================== 9 !! History : 4.0 ! 2016-03 (S. Flavoni) Original code 9 !! History : 4.0 ! 2016-03 (S. Flavoni) Original code 10 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 10 11 !!---------------------------------------------------------------------- 11 12 … … 24 25 PRIVATE 25 26 26 PUBLIC usr_def_istate ! called in istate.F90 27 PUBLIC usr_def_istate ! called in istate.F90 28 PUBLIC usr_def_istate_ssh ! called in sshwzv.F90 27 29 28 30 !! * Substitutions … … 34 36 !!---------------------------------------------------------------------- 35 37 CONTAINS 36 37 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 38 39 40 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 38 41 !!---------------------------------------------------------------------- 39 42 !! *** ROUTINE usr_def_istate *** … … 42 45 !! Here WAD_TEST_CASES configuration 43 46 !! 44 !! ** Method : - set temprature field47 q !! ** Method : - set temprature field 45 48 !! - set salinity field 46 49 !!---------------------------------------------------------------------- … … 50 53 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 51 54 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 52 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height53 55 INTEGER :: ji, jj ! dummy loop indices 54 56 REAL(wp) :: zi, zj … … 66 68 pu (:,:,:) = 0._wp ! ocean at rest 67 69 pv (:,:,:) = 0._wp 68 pssh(:,:) = 0._wp69 !70 70 ! ! T & S profiles 71 71 pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:) … … 83 83 CASE ( 1 ) ! WAD 1 configuration 84 84 ! ! ==================== 85 !86 85 IF(lwp) WRITE(numout,*) 87 86 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope' 88 87 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 89 !90 do ji = 1,jpi91 pssh(ji,:) = ( -5.5_wp + 7.4_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)92 end do93 88 ! ! ==================== 94 89 CASE ( 2, 8 ) ! WAD 2 configuration 95 90 ! ! ==================== 96 !97 91 IF(lwp) WRITE(numout,*) 98 92 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope' 99 93 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 100 !101 do ji = 1,jpi102 pssh(ji,:) = ( -1.5_wp + 5.0_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)103 end do104 94 ! ! ==================== 105 95 CASE ( 3 ) ! WAD 3 configuration 106 96 ! ! ==================== 107 !108 97 IF(lwp) WRITE(numout,*) 109 98 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope' 110 99 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 111 ! 112 do ji = 1,jpi 113 pssh(ji,:) = ( -4.5_wp + 6.8_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 114 end do 100 ! ! ==================== 101 CASE ( 4 ) ! WAD 4 configuration 102 ! ! ==================== 103 IF(lwp) WRITE(numout,*) 104 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic bowl, mid-range initial ssh slope' 105 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 106 ! ! =========================== 107 CASE ( 5, 7 ) ! WAD 5 and 7 configurations 108 ! ! =========================== 109 IF(lwp) WRITE(numout,*) 110 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Double slope with shelf' 111 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 112 ! ! ==================== 113 CASE ( 6 ) ! WAD 6 configuration 114 ! ! ==================== 115 IF(lwp) WRITE(numout,*) 116 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel with gaussian ridge' 117 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 118 ! 119 DO ji = mi0(jpiglo/2), mi0(jpiglo) 120 pts(ji,:,:,jp_sal) = 30._wp 121 END DO 122 ! 123 ! 124 ! ! =========================== 125 CASE DEFAULT ! NONE existing configuration 126 ! ! =========================== 127 WRITE(ctmp1,*) 'WAD test with a ', nn_cfg,' option is not coded' 128 ! 129 CALL ctl_stop( ctmp1 ) 130 ! 131 END SELECT 132 ! 133 END SUBROUTINE usr_def_istate 134 135 136 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 137 !!---------------------------------------------------------------------- 138 !! *** ROUTINE usr_def_istate_ssh *** 139 !! 140 !! ** Purpose : Initialization of the dynamics and tracers 141 !! Here WAD_TEST_CASES configuration 142 !! 143 !! ** Method : - set ssh 144 !!---------------------------------------------------------------------- 145 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 146 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height 147 INTEGER :: ji, jj ! dummy loop indices 148 REAL(wp) :: zi, zj 149 ! 150 INTEGER :: jk ! dummy loop indices 151 REAL(wp) :: zdam ! location of dam [Km] 152 !!---------------------------------------------------------------------- 153 ! 154 ! 155 SELECT CASE ( nn_cfg ) 156 ! ! ==================== 157 CASE ( 1 ) ! WAD 1 configuration 158 ! ! ==================== 159 ! 160 IF(lwp) WRITE(numout,*) 161 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope' 162 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 163 ! 164 DO ji = 1,jpi 165 pssh(ji,:) = ( -5.5_wp + 7.4_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 166 END DO 167 ! ! ==================== 168 CASE ( 2, 8 ) ! WAD 2 configuration 169 ! ! ==================== 170 ! 171 IF(lwp) WRITE(numout,*) 172 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope' 173 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 174 ! 175 DO ji = 1,jpi 176 pssh(ji,:) = ( -1.5_wp + 5.0_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 177 END DO 178 ! ! ==================== 179 CASE ( 3 ) ! WAD 3 configuration 180 ! ! ==================== 181 ! 182 IF(lwp) WRITE(numout,*) 183 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope' 184 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 185 ! 186 DO ji = 1,jpi 187 pssh(ji,:) = ( -4.5_wp + 6.8_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 188 END DO 115 189 116 190 ! … … 140 214 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 141 215 ! 142 doji = 1,jpi143 pssh(ji,:) = ( -2.5_wp + 5.5_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)144 end do216 DO ji = 1,jpi 217 pssh(ji,:) = ( -2.5_wp + 5.5_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 218 END DO 145 219 146 220 ! … … 153 227 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 154 228 ! 155 do ji = 1,jpi 156 pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1) 157 end do 158 ! 159 do ji = mi0(jpiglo/2), mi0(jpiglo) 160 pts(ji,:,:,jp_sal) = 30._wp 161 pssh(ji,:) = -0.1*ptmask(ji,:,1) 162 end do 229 DO ji = 1,jpi 230 pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1) 231 END DO 232 ! 233 DO ji = mi0(jpiglo/2), mi0(jpiglo) 234 pssh(ji,:) = -0.1*ptmask(ji,:,1) 235 END DO 163 236 ! 164 237 ! … … 182 255 END_2D 183 256 ! 184 END SUBROUTINE usr_def_istate 257 END SUBROUTINE usr_def_istate_ssh 185 258 186 259 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
