Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
r2528 r2715 4 4 !! Ocean dynamics: lateral viscosity trend 5 5 !!====================================================================== 6 !! History : OPA ! 1997-07 (G. Madec) Original code 7 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 8 !! 2.0 ! 2004-08 (C. Talandier) New trends organization 9 !!---------------------------------------------------------------------- 6 10 #if defined key_ldfslp || defined key_esopa 7 11 !!---------------------------------------------------------------------- … … 12 16 !! ldfguv : 13 17 !!---------------------------------------------------------------------- 14 !! * Modules used15 18 USE oce ! ocean dynamics and tracers 16 19 USE dom_oce ! ocean space and time domain 17 20 USE ldfdyn_oce ! ocean dynamics lateral physics 18 21 USE zdf_oce ! ocean vertical physics 19 USE in_out_manager ! I/O manager20 22 USE trdmod ! ocean dynamics trends 21 23 USE trdmod_oce ! ocean variables trends 22 24 USE ldfslp ! iso-neutral slopes available 25 USE in_out_manager ! I/O manager 26 USE lib_mpp ! MPP library 23 27 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 24 28 USE prtctl ! Print control … … 27 31 PRIVATE 28 32 29 !! * Routine accessibility 30 PUBLIC dyn_ldf_bilapg ! called by step.F90 33 PUBLIC dyn_ldf_bilapg ! called by step.F90 34 35 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zfvw , zdiu, zdiv ! 2D workspace (ldfguv) 36 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdju, zdj1u, zdjv, zdj1v ! 2D workspace (ldfguv) 31 37 32 38 !! * Substitutions … … 36 42 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 37 43 !! $Id$ 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 39 !!---------------------------------------------------------------------- 40 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 !!---------------------------------------------------------------------- 41 46 CONTAINS 47 48 INTEGER FUNCTION dyn_ldf_bilapg_alloc() 49 !!---------------------------------------------------------------------- 50 !! *** ROUTINE dyn_ldf_bilapg_alloc *** 51 !!---------------------------------------------------------------------- 52 ALLOCATE( zfuw(jpi,jpk) , zfvw (jpi,jpk) , zdiu(jpi,jpk) , zdiv (jpi,jpk) , & 53 & zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_bilapg_alloc ) 54 ! 55 IF( dyn_ldf_bilapg_alloc /= 0 ) CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays') 56 END FUNCTION dyn_ldf_bilapg_alloc 57 42 58 43 59 SUBROUTINE dyn_ldf_bilapg( kt ) … … 67 83 !! biharmonic mixing trend. 68 84 !! - save the trend in (zwk3,zwk4) ('key_trddyn') 69 !! 70 !! History : 71 !! 8.0 ! 97-07 (G. Madec) Original code 72 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 73 !! 9.0 ! 04-08 (C. Talandier) New trends organization 74 !!---------------------------------------------------------------------- 75 !! * Modules used 76 USE oce, ONLY : zwk3 => ta, & ! use ta as 3D workspace 77 zwk4 => sa ! use sa as 3D workspace 78 79 !! * Arguments 85 !!---------------------------------------------------------------------- 86 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 87 USE wrk_nemo, ONLY: zwk1 => wrk_3d_3 , zwk2 => wrk_3d_4 ! 3D workspace 88 USE oce , ONLY: zwk3 => ta , zwk4 => sa ! ta, sa used as 3D workspace 89 ! 80 90 INTEGER, INTENT( in ) :: kt ! ocean time-step index 81 82 !! * Local declarations 91 ! 83 92 INTEGER :: ji, jj, jk ! dummy loop indices 84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 85 zwk1, zwk2 ! work array used for rotated biharmonic 86 ! ! operator on tracers and/or momentum 87 !!---------------------------------------------------------------------- 93 !!---------------------------------------------------------------------- 94 95 IF( wrk_in_use(3, 3,4) ) THEN 96 CALL ctl_stop('dyn_ldf_bilapg: requested workspace arrays unavailable') ; RETURN 97 ENDIF 88 98 89 99 IF( kt == nit000 ) THEN … … 93 103 zwk1(:,:,:) = 0.e0 ; zwk3(:,:,:) = 0.e0 94 104 zwk2(:,:,:) = 0.e0 ; zwk4(:,:,:) = 0.e0 105 ! ! allocate dyn_ldf_bilapg arrays 106 IF( dyn_ldf_bilapg_alloc() /= 0 ) CALL ctl_stop('STOP', 'dyn_ldf_bilapg: failed to allocate arrays') 95 107 ENDIF 96 108 97 109 ! Laplacian of (ub,vb) multiplied by ahm 98 110 ! -------------------------------------- 99 ! rotated harmonic operator applied to (ub,vb) 100 ! and multiply by ahmu, ahmv (output in (zwk1,zwk2) ) 101 102 CALL ldfguv ( ub, vb, zwk1, zwk2, 1 ) 103 104 105 ! Lateral boundary conditions on (zwk1,zwk2) 106 CALL lbc_lnk( zwk1, 'U', -1. ) 107 CALL lbc_lnk( zwk2, 'V', -1. ) 108 111 CALL ldfguv( ub, vb, zwk1, zwk2, 1 ) ! rotated harmonic operator applied to (ub,vb) 112 ! ! and multiply by ahmu, ahmv (output in (zwk1,zwk2) ) 113 CALL lbc_lnk( zwk1, 'U', -1. ) ; CALL lbc_lnk( zwk2, 'V', -1. ) ! Lateral boundary conditions 109 114 110 115 ! Bilaplacian of (ub,vb) 111 116 ! ---------------------- 112 ! rotated harmonic operator applied to (zwk1,zwk2) (output in (zwk3,zwk4) ) 113 114 CALL ldfguv ( zwk1, zwk2, zwk3, zwk4, 2 ) 115 116 117 ! Update the momentum trends (j-slab : 2, jpj-1) 117 CALL ldfguv( zwk1, zwk2, zwk3, zwk4, 2 ) ! rotated harmonic operator applied to (zwk1,zwk2) 118 ! ! (output in (zwk3,zwk4) ) 119 120 ! Update the momentum trends 118 121 ! -------------------------- 119 ! ! =============== 120 DO jj = 2, jpjm1 ! Vertical slab 121 ! ! =============== 122 DO jj = 2, jpjm1 ! add the diffusive trend to the general momentum trends 122 123 DO jk = 1, jpkm1 123 124 DO ji = 2, jpim1 124 ! add the diffusive trend to the general momentum trends125 125 ua(ji,jj,jk) = ua(ji,jj,jk) + zwk3(ji,jj,jk) 126 126 va(ji,jj,jk) = va(ji,jj,jk) + zwk4(ji,jj,jk) 127 127 END DO 128 128 END DO 129 ! ! ===============130 END DO ! End of slab131 ! ! ===============132 129 END DO 130 ! 131 IF( wrk_not_released(3, 3,4) ) CALL ctl_stop('dyn_ldf_bilapg: failed to release workspace arrays') 132 ! 133 133 END SUBROUTINE dyn_ldf_bilapg 134 134 … … 174 174 !! second order vertical derivative term) 175 175 !! 'key_trddyn' defined: the trend is saved for diagnostics. 176 !! 177 !! History : 178 !! 8.0 ! 97-07 (G. Madec) Original code 179 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 180 !!---------------------------------------------------------------------- 181 !! * Arguments 182 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: & 183 pu, pv ! momentum fields (before u and v for the 1st call, and 184 ! ! laplacian of these fields multiplied by ahm for the 2nd 185 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) :: & 186 plu, plv ! partial harmonic operator applied to 187 ! ! pu and pv (all the components except 188 ! ! second order vertical derivative term) 189 INTEGER, INTENT( in ) :: & 190 kahm ! =1 the laplacian is multiplied by the eddy diffusivity coef. 191 ! ! =2 no multiplication 192 193 !! * Local declarations 194 INTEGER :: ji, jj, jk ! dummy loop indices 195 REAL(wp) :: & 196 zabe1, zabe2, zcof1, zcof2, & ! temporary scalars 197 zcoef0, zcoef3, zcoef4 198 REAL(wp) :: & 199 zbur, zbvr, zmkt, zmkf, zuav, zvav, & 200 zuwslpi, zuwslpj, zvwslpi, zvwslpj 201 REAL(wp), DIMENSION(jpi,jpj) :: & 202 ziut, zjuf , zjvt, zivf, & ! workspace 203 zdku, zdk1u, zdkv, zdk1v 204 REAL(wp), DIMENSION(jpi,jpk) :: & 205 zfuw, zfvw, zdiu, zdiv, & ! workspace 206 zdju, zdj1u, zdjv, zdj1v 207 !!---------------------------------------------------------------------- 208 176 !!---------------------------------------------------------------------- 177 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 178 USE wrk_nemo, ONLY: ziut => wrk_2d_1 , zjuf => wrk_2d_2 , zjvt => wrk_2d_3 179 USE wrk_nemo, ONLY: zivf => wrk_2d_4 , zdku => wrk_2d_5 , zdk1u => wrk_2d_6 180 USE wrk_nemo, ONLY: zdkv => wrk_2d_7 , zdk1v => wrk_2d_8 181 !! 182 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu , pv ! 1st call: before horizontal velocity 183 ! ! 2nd call: ahm x these fields 184 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: plu, plv ! partial harmonic operator applied to 185 ! ! pu and pv (all the components except 186 ! ! second order vertical derivative term) 187 INTEGER , INTENT(in ) :: kahm ! =1 1st call ; =2 2nd call 188 ! 189 INTEGER :: ji, jj, jk ! dummy loop indices 190 REAL(wp) :: zabe1 , zabe2 , zcof1 , zcof2 ! local scalar 191 REAL(wp) :: zcoef0, zcoef3, zcoef4 ! - - 192 REAL(wp) :: zbur, zbvr, zmkt, zmkf, zuav, zvav ! - - 193 REAL(wp) :: zuwslpi, zuwslpj, zvwslpi, zvwslpj ! - - 194 !!---------------------------------------------------------------------- 195 196 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8) ) THEN 197 CALL ctl_stop('dyn:ldfguv: requested workspace arrays unavailable') ; RETURN 198 END IF 209 199 ! ! ********** ! ! =============== 210 200 DO jk = 1, jpkm1 ! First step ! ! Horizontal slab … … 461 451 END DO ! End of slab 462 452 ! ! =============== 453 454 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8) ) CALL ctl_stop('dyn:ldfguv: failed to release workspace arrays') 455 ! 463 456 END SUBROUTINE ldfguv 464 457 … … 469 462 CONTAINS 470 463 SUBROUTINE dyn_ldf_bilapg( kt ) ! Dummy routine 464 INTEGER, INTENT(in) :: kt 471 465 WRITE(*,*) 'dyn_ldf_bilapg: You should not have seen this print! error?', kt 472 466 END SUBROUTINE dyn_ldf_bilapg
Note: See TracChangeset
for help on using the changeset viewer.
