Changeset 58 for trunk/NEMO/LIM_SRC
- Timestamp:
- 2004-04-22T12:10:45+02:00 (20 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/LIM_SRC/limmsh.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC/limmsh.F90
r12 r58 1 1 MODULE limmsh 2 #if defined key_ice_lim3 2 !!====================================================================== 4 3 !! *** MODULE limmsh *** 5 4 !! LIM ice model : definition of the ice mesh parameters 6 5 !!====================================================================== 7 6 #if defined key_ice_lim 7 !!---------------------------------------------------------------------- 8 !! 'key_ice_lim' LIM sea-ice model 8 9 !!---------------------------------------------------------------------- 9 10 !! lim_msh : definition of the ice mesh … … 14 15 USE dom_ice 15 16 USE lbclnk 17 USE in_out_manager 16 18 17 19 IMPLICIT NONE … … 51 53 ! ! (resp. y direction) (defined at the center) 52 54 REAL(wp) :: & 53 zh1p , zh2p , & ! Idem zh1, zh2 for the bottom left corner of the grid 54 zd2d1p, zd1d2p, & ! Idem zd2d1, zd1d2 for the bottom left corner of the grid 55 zusden, zusden2, & ! temporary scalars 56 zaire4 ! " " 55 zh1p , zh2p , & ! Idem zh1, zh2 for the bottom left corner of the grid 56 zd2d1p, zd1d2p , & ! Idem zd2d1, zd1d2 for the bottom left corner of the grid 57 zusden, zusden2 ! temporary scalars 57 58 !!--------------------------------------------------------------------- 58 !! LIM 2.0, UCL-LODYC-IPSL (2002) 59 !!--------------------------------------------------------------------- 59 60 IF(lwp) THEN 61 WRITE(numout,*) 62 WRITE(numout,*) 'lim_msh : LIM sea-ice model, mesh initialization' 63 WRITE(numout,*) '~~~~~~~' 64 ENDIF 60 65 61 66 !---------------------------------------------------------- … … 63 68 !------------------------------------------------------------------ 64 69 65 jeq = INT( jpj / 2 ) !i bug mpp potentiel66 jeqm1 =jeq - 170 njeq = INT( jpj / 2 ) !i bug mpp potentiel 71 njeqm1 = njeq - 1 67 72 68 73 fcor(:,:) = 2. * omega * SIN( gphit(:,:) * rad ) ! coriolis factor 69 74 75 !i DO jj = 1, jpj 76 !i zmsk(jj) = SUM( tmask(:,jj,:) ) ! = 0 if land everywhere on a j-line 77 !!ii write(numout,*) jj, zind(jj) 78 !i END DO 79 80 IF( fcor(1,1) * fcor(1,nlcj) < 0.e0 ) THEN ! local domain include both hemisphere 81 l_jeq = .TRUE. 82 njeq = 1 83 DO WHILE ( njeq <= jpj .AND. fcor(1,njeq) < 0.e0 ) 84 njeq = njeq + 1 85 END DO 86 IF(lwp ) WRITE(numout,*) ' the equator is inside the domain at about njeq = ', njeq 87 ELSEIF( fcor(1,1) < 0.e0 ) THEN 88 l_jeq = .FALSE. 89 njeq = jpj + 10 90 IF(lwp ) WRITE(numout,*) ' the model domain is entirely in the southern hemisphere: njeq = ', njeq 91 ELSE 92 l_jeq = .FALSE. 93 njeq = -10 94 IF(lwp ) WRITE(numout,*) ' the model domain is entirely in the northern hemisphere: njeq = ', njeq 95 ENDIF 96 97 njeqm1 = njeq - 1 98 70 99 71 100 ! For each grid, definition of geometric tables … … 73 102 74 103 !------------------- 75 ! Conventions : |104 ! Conventions : ! 76 105 !------------------- 77 106 ! indices 1 \ 2 <-> localisation in the 2 direction x \ y … … 80 109 ! 3 = corner SW x(i-1/2),y(j-1/2) 81 110 !------------------- 111 !!ibug ??? 112 akappa(:,:,:,:) = 0.e0 113 wght(:,:,:,:) = 0.e0 114 alambd(:,:,:,:,:,:) = 0.e0 115 tmu(:,:) = 0.e0 116 !!i 82 117 83 118 … … 86 121 ! ! akappa 87 122 DO jj = 2, jpj 88 DO ji = 1, jpi 89 zd1d2(ji,jj) = e1v(ji,jj) - e1v(ji,jj-1) 90 END DO 123 zd1d2(:,jj) = e1v(:,jj) - e1v(:,jj-1) 91 124 END DO 92 125 CALL lbc_lnk( zd1d2, 'T', -1. ) 93 126 94 DO jj = 1, jpj 95 DO ji = 2, jpi 96 zd2d1(ji,jj) = e2u(ji,jj) - e2u(ji-1,jj) 97 END DO 127 DO ji = 2, jpi 128 zd2d1(ji,:) = e2u(ji,:) - e2u(ji-1,:) 98 129 END DO 99 130 CALL lbc_lnk( zd2d1, 'T', -1. ) 100 131 101 DO jj = 1, jpj 102 DO ji = 1, jpi 103 zaire4 = 4.0 * e1t(ji,jj) * e2t(ji,jj) 104 akappa(ji,jj,1,1) = 1.0 / ( 2.0 * e1t(ji,jj) ) 105 akappa(ji,jj,1,2) = zd1d2(ji,jj) / zaire4 106 akappa(ji,jj,2,1) = zd2d1(ji,jj) / zaire4 107 akappa(ji,jj,2,2) = 1.0 / ( 2.0 * e2t(ji,jj) ) 108 END DO 109 END DO 132 akappa(:,:,1,1) = 1.0 / ( 2.0 * e1t(:,:) ) 133 akappa(:,:,1,2) = zd1d2(:,:) / ( 4.0 * e1t(:,:) * e2t(:,:) ) 134 akappa(:,:,2,1) = zd2d1(:,:) / ( 4.0 * e1t(:,:) * e2t(:,:) ) 135 akappa(:,:,2,2) = 1.0 / ( 2.0 * e2t(:,:) ) 110 136 111 137 ! ! weights (wght) … … 140 166 & + e2t(ji-1,jj-1) * wght(ji,jj,1,1) 141 167 142 ! better writ en but change the last digit and thus solver in less than 100 timestep168 ! better written but change the last digit and thus solver in less than 100 timestep 143 169 ! zh1p = e1t(ji-1,jj ) * wght(ji,jj,1,2) + e1t(ji,jj ) * wght(ji,jj,2,2) & 144 170 ! & + e1t(ji-1,jj-1) * wght(ji,jj,1,1) + e1t(ji,jj-1) * wght(ji,jj,2,1) … … 147 173 ! & + e2t(ji-1,jj-1) * wght(ji,jj,1,1) + e2t(ji,jj-1) * wght(ji,jj,2,1) 148 174 149 zusden = 1.0 / ( zh1p * zh2p * 4.e0 ) 175 !!ibug =0 zusden = 1.0 / ( zh1p * zh2p * 4.e0 ) 176 zusden = 1.0 / MAX( zh1p * zh2p * 4.e0 , 1.e-20 ) 150 177 zusden2 = zusden * 2.0 151 178 … … 195 222 CALL lbc_lnk( alambd(:,:,2,1,1,2), 'I', 1. ) ! 196 223 197 ! Definition of scale dephts : bathymetry 198 !------------------------------------------- 199 !i bug dz forced to 10 meters 200 dz = 10 !!bug potential bug if first level not equal to 10 m 201 !!! dz = gdept(1) 202 203 224 204 225 ! Initialization of ice masks 205 226 !---------------------------- … … 221 242 ! unmasked and masked area of T-grid cell 222 243 area(:,:) = e1t(:,:) * e2t(:,:) 223 aire(:,:) = area(:,:) * tms(:,:)224 244 225 245 END SUBROUTINE lim_msh 246 226 247 #else 227 !!============================================================================== 228 !! *** MODULE limmsh *** 229 !! No sea ice 230 !!============================================================================== 248 !!---------------------------------------------------------------------- 249 !! Default option Dummy Module NO LIM sea-ice model 250 !!---------------------------------------------------------------------- 231 251 CONTAINS 232 SUBROUTINE lim_msh ! Empty routine252 SUBROUTINE lim_msh ! Dummy routine 233 253 END SUBROUTINE lim_msh 234 235 254 #endif 255 236 256 !!====================================================================== 237 257 END MODULE limmsh
Note: See TracChangeset
for help on using the changeset viewer.
