Changeset 900 for trunk/NEMO/C1D_SRC/dyncor_c1d.F90
- Timestamp:
- 2008-04-22T20:13:41+02:00 (16 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/C1D_SRC/dyncor_c1d.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/C1D_SRC/dyncor_c1d.F90
r899 r900 1 MODULE dyncor 1d1 MODULE dyncor_c1d 2 2 !!====================================================================== 3 !! *** MODULE ini1D***4 !! Ocean state : 1D initialization3 !! *** MODULE dyncor_c1d *** 4 !! Ocean Dynamics : Coriolis term in 1D configuration 5 5 !!===================================================================== 6 !! History : 2.0 ! 2004-09 (C. Ethe) Original code 7 !! 3.0 ! 2008-04 (G. Madec) style only 8 !!---------------------------------------------------------------------- 6 9 #if defined key_c1d 7 10 !!---------------------------------------------------------------------- 8 !! 'key_c1d' 1D Configuration11 !! 'key_c1d' 1D Configuration 9 12 !!---------------------------------------------------------------------- 13 !! cor_c1d : Coriolis factor at T-point (1D configuration) 14 !! dyn_cor_c1d : vorticity trend due to Coriolis at T-point 10 15 !!---------------------------------------------------------------------- 11 !! fcorio_1d : Coriolis factor at T-point 12 !! dyn_cor_1d : vorticity trend due to Coriolis 13 !!---------------------------------------------------------------------- 14 !! * Modules used 15 USE oce ! ocean dynamics and tracers 16 USE dom_oce ! ocean space and time domain 17 USE phycst ! physical constants 18 USE in_out_manager ! I/O manager 19 USE prtctl ! Print control 16 USE oce ! ocean dynamics and tracers 17 USE dom_oce ! ocean space and time domain 18 USE phycst ! physical constants 19 USE in_out_manager ! I/O manager 20 USE prtctl ! Print control 20 21 21 22 IMPLICIT NONE 22 23 PRIVATE 23 24 24 !! * Routine accessibility 25 PUBLIC fcorio_1d ! routine called by OPA.F90 26 PUBLIC dyn_cor_1d ! routine called by step1d.F90 25 PUBLIC cor_c1d ! routine called by OPA.F90 26 PUBLIC dyn_cor_c1d ! routine called by step1d.F90 27 27 28 28 !! * Substitutions 29 29 # include "vectopt_loop_substitute.h90" 30 30 !!---------------------------------------------------------------------- 31 !! OPA 9.0 , LOCEAN-IPSL (2005)31 !! NEMO/C1D 3.0 , LOCEAN-IPSL (2009) 32 32 !! $Header$ 33 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt33 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 34 34 !!---------------------------------------------------------------------- 35 35 36 36 CONTAINS 37 37 38 SUBROUTINE fcorio_1d38 SUBROUTINE cor_c1d 39 39 !!---------------------------------------------------------------------- 40 !! *** ROUTINE fcorio_1d ***40 !! *** ROUTINE cor_c1d *** 41 41 !! 42 42 !! ** Purpose : Compute the Coriolis factor at T-point 43 !!44 !! ** Method :45 !!46 !! History :47 !! 9.0 ! 04-09 (C. Ethe) 1D configuration48 43 !!---------------------------------------------------------------------- 49 !! * Local declarations 50 !!---------------------------------------------------------------------- 51 REAL(wp) :: & 52 zphi0, zbeta, zf0 ! temporary scalars 53 54 44 REAL(wp) :: zphi0, zbeta, zf0 ! temporary scalars 55 45 !!---------------------------------------------------------------------- 56 46 57 ! ================= !58 ! Coriolis factor !59 ! ================= !60 47 IF(lwp) WRITE(numout,*) 61 IF(lwp) WRITE(numout,*) ' fcorio_1d : Coriolis factor at T-point'62 IF(lwp) WRITE(numout,*) '~~~~~~~ ~~~~'48 IF(lwp) WRITE(numout,*) 'cor_c1d : Coriolis factor at T-point' 49 IF(lwp) WRITE(numout,*) '~~~~~~~' 63 50 64 51 SELECT CASE( jphgr_msh ) ! type of horizontal mesh 65 52 ! 66 53 CASE ( 0, 1, 4 ) ! mesh on the sphere 67 68 54 ff(:,:) = 2. * omega * SIN( rad * gphit(:,:) ) 69 55 ! 70 56 CASE ( 2 ) ! f-plane at ppgphi0 71 72 57 ff(:,:) = 2. * omega * SIN( rad * ppgphi0 ) 73 74 58 IF(lwp) WRITE(numout,*) ' f-plane: Coriolis parameter = constant = ', ff(1,1) 75 59 ! 76 60 CASE ( 3 ) ! beta-plane 77 78 61 zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra ! beta at latitude ppgphi0 79 62 zphi0 = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m *1.e-3 / ( ra * rad ) ! latitude of the first row F-points 80 63 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south 81 82 64 ff(:,:) = ( zf0 + zbeta * gphit(:,:) * 1.e+3 ) ! f = f0 +beta* y ( y=0 at south) 83 84 65 IF(lwp) WRITE(numout,*) ' Beta-plane: Beta parameter = constant = ', ff(1,1) 85 66 IF(lwp) WRITE(numout,*) ' Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj) 86 67 ! 87 68 CASE ( 5 ) ! beta-plane and rotated domain 88 89 69 zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra ! beta at latitude ppgphi0 90 70 zphi0 = 15.e0 ! latitude of the first row F-points 91 71 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south 92 93 72 ff(:,:) = ( zf0 + zbeta * ABS( gphit(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 94 95 73 IF(lwp) WRITE(numout,*) ' Beta-plane: Beta parameter = constant = ', ff(1,1) 96 74 IF(lwp) WRITE(numout,*) ' Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj) 97 75 ! 98 76 END SELECT 99 100 END SUBROUTINE fcorio_1d77 ! 78 END SUBROUTINE cor_c1d 101 79 102 80 103 SUBROUTINE dyn_cor_ 1d( kt )81 SUBROUTINE dyn_cor_c1d( kt ) 104 82 !!---------------------------------------------------------------------- 105 !! *** ROUTINE dyn_cor_ 1d ***83 !! *** ROUTINE dyn_cor_c1d *** 106 84 !! 107 85 !! ** Purpose : Compute the now total vorticity trend and add it to … … 113 91 !! 9.0 ! 04-09 (C. Ethe) 1D configuration 114 92 !!---------------------------------------------------------------------- 115 !! * Arguments 116 INTEGER, INTENT( in ) :: kt ! ocean time-step index 117 118 !! * Local declarations 119 INTEGER :: ji, jj, jk ! dummy loop indices 120 REAL(wp) :: & 121 zua, zva ! temporary scalars 122 93 INTEGER, INTENT( in ) :: kt ! ocean time-step index 94 !! 95 INTEGER :: ji, jj, jk ! dummy loop indices 123 96 !!---------------------------------------------------------------------- 124 97 ! 125 98 IF( kt == nit000 ) THEN 126 99 IF(lwp) WRITE(numout,*) 127 IF(lwp) WRITE(numout,*) 'dyn_cor_ 1d : total vorticity trend in 1D'100 IF(lwp) WRITE(numout,*) 'dyn_cor_c1d : total vorticity trend in 1D' 128 101 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 129 102 ENDIF 130 103 ! 131 104 DO jk = 1, jpkm1 132 105 DO jj = 2, jpjm1 133 106 DO ji = fs_2, fs_jpim1 ! vector opt. 134 zua = ff(ji,jj) * vn(ji,jj,jk) 135 zva = - ff(ji,jj) * un(ji,jj,jk) 136 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 137 va(ji,jj,jk) = va(ji,jj,jk) + zva 107 ua(ji,jj,jk) = ua(ji,jj,jk) + ff(ji,jj) * vn(ji,jj,jk) 108 va(ji,jj,jk) = va(ji,jj,jk) - ff(ji,jj) * un(ji,jj,jk) 138 109 END DO 139 110 END DO 140 111 END DO 141 142 IF(ln_ctl) THEN 143 CALL prt_ctl(tab3d_1=ua, clinfo1=' cor - Ua: ', mask1=umask, & 144 & tab3d_2=va, clinfo2=' Va: ', mask2=vmask) 145 ENDIF 146 147 ! IF(l_ctl) THEN ! print sum trends (used for debugging) 148 ! zua = SUM( ua(2:nictl,2:njctl,1:jpkm1) * umask(2:nictl,2:njctl,1:jpkm1) ) 149 ! zva = SUM( va(2:nictl,2:njctl,1:jpkm1) * vmask(2:nictl,2:njctl,1:jpkm1) ) 150 ! WRITE(numout,*) ' cor - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl 151 ! u_ctl = zua ; v_ctl = zva 152 ! ENDIF 153 154 END SUBROUTINE dyn_cor_1d 112 ! 113 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' cor - Ua: ', mask1=umask, & 114 & tab3d_2=va, clinfo2=' Va: ' , mask2=vmask ) 115 ! 116 END SUBROUTINE dyn_cor_c1d 155 117 156 118 #else 157 119 !!---------------------------------------------------------------------- 158 !! Default key NO 1D Config 120 !! Default key NO 1D Configuration 159 121 !!---------------------------------------------------------------------- 160 122 CONTAINS 161 SUBROUTINE fcorio_1d! Empty routine162 END SUBROUTINE fcorio_1d163 SUBROUTINE dyn_cor_ 1d ( kt )164 WRITE(*,*) 'dyn_cor_ 1d: You should not have seen this print! error?', kt165 END SUBROUTINE dyn_cor_ 1d123 SUBROUTINE cor_c1d ! Empty routine 124 END SUBROUTINE cor_c1d 125 SUBROUTINE dyn_cor_c1d ( kt ) ! Empty routine 126 WRITE(*,*) 'dyn_cor_c1d: You should not have seen this print! error?', kt 127 END SUBROUTINE dyn_cor_c1d 166 128 #endif 167 129 168 130 !!===================================================================== 169 END MODULE dyncor 1d131 END MODULE dyncor_c1d
Note: See TracChangeset
for help on using the changeset viewer.
