Changeset 16 for trunk/NEMO/OPA_SRC
- Timestamp:
- 2004-02-17T09:06:15+01:00 (20 years ago)
- Location:
- trunk/NEMO/OPA_SRC
- Files:
-
- 26 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DTA/dtasal.F90
r3 r16 23 23 24 24 !! * Shared module variables 25 LOGICAL , PUBLIC, PARAMETER :: lk_dtasal = .TRUE. ! salinity data flag26 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & 27 s_dta ! salinity data at given time-step25 LOGICAL , PUBLIC, PARAMETER :: lk_dtasal = .TRUE. !: salinity data flag 26 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 27 s_dta !: salinity data at given time-step 28 28 29 29 !! * Module variables … … 81 81 INTEGER :: ji, jj, jk, jl ! dummy loop indicies 82 82 INTEGER :: & 83 imois, iman, ik, i15, & ! temporary integers 84 ipi, ipj, ipk, itime ! " " 83 imois, iman, ik, i15, & ! temporary integers 84 ipi, ipj, ipk, itime, & ! " " 85 il0, il1, ii0, ii1, ij0, ij1 ! " " 85 86 INTEGER, DIMENSION(jpmois) :: istep 86 87 REAL(wp) :: & … … 186 187 ! ! ORCA_R2 configuration 187 188 ! ! ======================= 188 189 DO jj = mj0(101), mj1(109) ! Reduced salinity in the Alboran Sea 190 DO ji = mi0(141), mi1(155) 189 ij0 = 101 ; ij1 = 109 190 ii0 = 141 ; ii1 = 155 191 DO jj = mj0(ij0), mj1(ij1) ! Reduced salinity in the Alboran Sea 192 DO ji = mi0(ii0), mi1(ii1) 191 193 DO jk = 13, 13 192 194 saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.15 … … 205 207 IF( n_cla == 1 ) THEN 206 208 ! ! New salinity profile at Gibraltar 207 saldta( mi0(139):mi1(139) , mj0(101):mj1(101) , : , : ) = & 208 & saldta( mi0(138):mi1(138) , mj0(101):mj1(101) , : , : ) 209 saldta( mi0(139):mi1(139) , mj0(102):mj1(102) , : , : ) = & 210 & saldta( mi0(138):mi1(138) , mj0(102):mj1(102) , : , : ) 211 DO jl = mi0(138), mi1(138) ! New temperature profile at Gibraltar 212 DO jj = mj0(101), mj1(102) 213 DO ji = mi0(139), mi1(139) 209 il0 = 138 ; il1 = 138 210 ij0 = 101 ; ij1 = 101 211 ii0 = 139 ; ii1 = 139 212 saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) = & 213 & saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 214 ij0 = 101 ; ij1 = 101 215 saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) = & 216 & saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 217 il0 = 138 ; il1 = 138 218 ij0 = 101 ; ij1 = 102 219 ii0 = 139 ; ii1 = 139 220 DO jl = mi0(ii0), mi1(ii1) ! New salinity profile at Gibraltar 221 DO jj = mj0(ij0), mj1(ij1) 222 DO ji = mi0(ii0), mi1(ii1) 214 223 saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 215 224 END DO … … 217 226 END DO 218 227 219 DO jl = mi0(164), mi1(164) ! New salinity profile at Bab el Mandeb 220 DO jj = mj0(88), mj1(88) 221 DO ji = mi0(161), mi1(163) 228 il0 = 164 ; il1 = 164 229 ij0 = 88 ; ij1 = 88 230 ii0 = 161 ; ii1 = 163 231 DO jl = mi0(ii0), mi1(ii1) ! New salinity profile at Bab el Mandeb 232 DO jj = mj0(ij0), mj1(ij1) 233 DO ji = mi0(ii0), mi1(ii1) 222 234 saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 223 235 END DO 224 236 END DO 225 DO jj = mj0(87), mj1(87) 226 DO ji = mi0(161), mi1(163) 237 ij0 = 87 ; ij1 = 87 238 DO jj = mj0(ij0), mj1(ij1) 239 DO ji = mi0(ii0), mi1(ii1) 227 240 saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 228 241 END DO … … 280 293 !! Default option: NO salinity data 281 294 !!---------------------------------------------------------------------- 282 LOGICAL , PUBLIC, PARAMETER :: lk_dtasal = .FALSE. !salinity data flag295 LOGICAL , PUBLIC, PARAMETER :: lk_dtasal = .FALSE. !: salinity data flag 283 296 CONTAINS 284 297 SUBROUTINE dta_sal( kt ) ! Empty routine 285 WRITE(*,*) kt298 WRITE(*,*) 'dta_sal: You should not have seen this print! error?', kt 286 299 END SUBROUTINE dta_sal 287 300 #endif -
trunk/NEMO/OPA_SRC/DTA/dtasst.F90
r3 r16 26 26 !! * Shared module variables 27 27 #if defined key_dtasst 28 LOGICAL , PUBLIC, PARAMETER :: lk_dtasst = .TRUE. ! sst data flag28 LOGICAL , PUBLIC, PARAMETER :: lk_dtasst = .TRUE. !: sst data flag 29 29 #else 30 LOGICAL , PUBLIC, PARAMETER :: lk_dtasst = . TRUE. !sst data flag30 LOGICAL , PUBLIC, PARAMETER :: lk_dtasst = .FALSE. !: sst data flag 31 31 #endif 32 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & 33 sst ! surface temperature34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2) :: & 35 rclice ! climatological ice index (0/1) (2 months)32 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 33 sst !: surface temperature 34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2) :: & !: 35 rclice !: climatological ice index (0/1) (2 months) 36 36 !!---------------------------------------------------------------------- 37 37 !! OPA 9.0 , IPSL-LODYC (2003) -
trunk/NEMO/OPA_SRC/DTA/dtatem.F90
r3 r16 23 23 24 24 !! * Shared module variables 25 LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .TRUE. ! temperature data flag26 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & 27 t_dta ! temperature data at given time-step25 LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .TRUE. !: temperature data flag 26 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 27 t_dta !: temperature data at given time-step 28 28 29 29 !! * Module variables … … 91 91 INTEGER :: & 92 92 imois, iman, itime, ik , & ! temporary integers 93 i15, ipi, ipj, ipk ! " " 93 i15, ipi, ipj, ipk, & ! " " 94 il0, il1, ii0, ii1, ij0, ij1 ! " " 94 95 95 96 INTEGER, DIMENSION(jpmois) :: istep … … 192 193 ! ! ======================= 193 194 194 DO jj = mj0(101), mj1(109) ! Reduced temperature at Alboran Sea 195 DO ji = mi0(141), mi1(155) 195 ij0 = 101 ; ij1 = 109 196 ii0 = 141 ; ii1 = 155 197 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 198 DO ji = mi0(ii0), mi1(ii1) 196 199 temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 197 200 temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 … … 202 205 IF( n_cla == 0 ) THEN 203 206 ! ! Reduced temperature at Red Sea 204 temdta( mi0(148):mi1(160) , mj0(87):mj1(96) , 4:10 , : ) = 7.0 205 temdta( mi0(148):mi1(160) , mj0(87):mj1(96) , 11:13 , : ) = 6.5 206 temdta( mi0(148):mi1(160) , mj0(87):mj1(96) , 14:20 , : ) = 6.0 207 ij0 = 87 ; ij1 = 96 208 ii0 = 148 ; ii1 = 160 209 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 210 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 211 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 207 212 ELSE 208 DO jl = mi0(138), mi1(138) ! New temperature profile at Gibraltar 209 DO jj = mj0(101), mj1(102) 210 DO ji = mi0(139), mi1(139) 213 il0 = 138 ; il1 = 138 214 ij0 = 101 ; ij1 = 102 215 ii0 = 139 ; ii1 = 139 216 DO jl = mi0(ii0), mi1(ii1) ! New temperature profile at Gibraltar 217 DO jj = mj0(ij0), mj1(ij1) 218 DO ji = mi0(ii0), mi1(ii1) 211 219 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 212 220 END DO 213 221 END DO 214 222 END DO 215 DO jl = mi0(164), mi1(164) ! New temperature profile at Bab el Mandeb 216 DO jj = mj0(88), mj1(88) 217 DO ji = mi0(161), mi1(163) 223 il0 = 164 ; il1 = 164 224 ij0 = 88 ; ij1 = 88 225 ii0 = 161 ; ii1 = 163 226 DO jl = mi0(ii0), mi1(ii1) ! New temperature profile at Bab el Mandeb 227 DO jj = mj0(ij0), mj1(ij1) 228 DO ji = mi0(ii0), mi1(ii1) 218 229 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 219 230 END DO 220 231 END DO 221 DO jj = mj0(87), mj1(87) 222 DO ji = mi0(161), mi1(163) 232 ij0 = 87 ; ij1 = 87 233 DO jj = mj0(ij0), mj1(ij1) 234 DO ji = mi0(ii0), mi1(ii1) 223 235 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 224 236 END DO … … 274 286 !! Default case NO 3D temperature data field 275 287 !!---------------------------------------------------------------------- 276 LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .FALSE. ! temperature data flag288 LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .FALSE. !: temperature data flag 277 289 CONTAINS 278 290 SUBROUTINE dta_tem( kt ) ! Empty routine 279 WRITE(*,*) kt291 WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt 280 292 END SUBROUTINE dta_tem 281 293 #endif -
trunk/NEMO/OPA_SRC/FLO/flo4rk.F90
r3 r16 15 15 USE oce ! ocean dynamics and tracers 16 16 USE dom_oce ! ocean space and time domain 17 USE in_out_manager ! I/O manager 17 18 18 19 IMPLICIT NONE … … 24 25 !! * Module variables 25 26 REAL(wp), DIMENSION (4) :: & ! RK4 and Lagrange interpolation 26 tcoef1 = / 1.0 , 0.5 , 0.5 , 0.0 /, & ! coeffients for27 tcoef2 = / 0.0 , 0.5 , 0.5 , 1.0 /, & ! lagrangian interp.28 scoef2 = / 1.0 , 2.0 , 2.0 , 1.0 /, & ! RK4 coefficients29 rcoef = /-1./6. , 1./2. ,-1./2. , 1./6. /! ???27 tcoef1 = (/ 1.0 , 0.5 , 0.5 , 0.0 /) , & ! coeffients for 28 tcoef2 = (/ 0.0 , 0.5 , 0.5 , 1.0 /) , & ! lagrangian interp. 29 scoef2 = (/ 1.0 , 2.0 , 2.0 , 1.0 /) , & ! RK4 coefficients 30 rcoef = (/-1./6. , 1./2. ,-1./2. , 1./6. /) ! ??? 30 31 REAL(wp), DIMENSION (3) :: & 31 scoef1 = / .5, .5, 1. /! compute position with interpolated32 scoef1 = (/ .5, .5, 1. /) ! compute position with interpolated 32 33 !!---------------------------------------------------------------------- 33 34 !! OPA 9.0 , LODYC-IPSL (2003) -
trunk/NEMO/OPA_SRC/FLO/flo_oce.F90
r3 r16 11 11 !! OPA 9.0 , LODYC-IPSL (2003) 12 12 !!---------------------------------------------------------------------- 13 #if defined key_floats13 #if defined key_floats || defined key_esopa 14 14 !!---------------------------------------------------------------------- 15 15 !! 'key_floats' drifting floats … … 20 20 IMPLICIT NONE 21 21 22 LOGICAL, PUBLIC, PARAMETER :: lk_floats = .TRUE. ! float flag22 LOGICAL, PUBLIC, PARAMETER :: lk_floats = .TRUE. !: float flag 23 23 24 24 !! float parameters 25 25 !! ---------------- 26 26 INTEGER, PARAMETER :: & 27 jpnfl = 23 ,& ! total number of floats during the run28 jpnnewfl = 0 ,& ! number of floats added in a new run29 jpnrst arfl = jpnfl-jpnnewfl! number of floats for the restart27 jpnfl = 23 , & ! total number of floats during the run 28 jpnnewflo = 0 , & ! number of floats added in a new run 29 jpnrstflo = jpnfl-jpnnewflo ! number of floats for the restart 30 30 31 31 !! float variables … … 61 61 !! Default option : NO drifting floats 62 62 !!---------------------------------------------------------------------- 63 LOGICAL, PUBLIC, PARAMETER :: lk_floats = .FALSE. ! float flag63 LOGICAL, PUBLIC, PARAMETER :: lk_floats = .FALSE. !: float flag 64 64 #endif 65 65 -
trunk/NEMO/OPA_SRC/FLO/floats.F90
r3 r16 67 67 ENDIF 68 68 69 # if defined key_mpp 70 CALL mppsync 71 # endif 69 IF( lk_mpp ) CALL mppsync ! synchronization of all the processor 70 72 71 73 72 ! Writing and restart … … 98 97 99 98 !! * Local declarations 100 NAMELIST/namflo/ ln_rst arfl, nwritefl, nstockfl99 NAMELIST/namflo/ ln_rstflo, nwritefl, nstockfl 101 100 !!--------------------------------------------------------------------- 102 101 ! Namelist namflo : floats 103 102 104 103 ! default values 105 ln_rst arfl= .FALSE.104 ln_rstflo = .FALSE. 106 105 nwritefl = 150 107 106 nstockfl = 450 … … 114 113 WRITE(numout,*) ' ' 115 114 WRITE(numout,*) ' Namelist floats :' 116 WRITE(numout,*) ' restart ln_rst arfl = ', ln_rstarfl117 WRITE(numout,*) ' frequency of float output file nwritefl 118 WRITE(numout,*) ' frequency of float restart file nstockfl 115 WRITE(numout,*) ' restart ln_rstflo = ', ln_rstflo 116 WRITE(numout,*) ' frequency of float output file nwritefl = ', nwritefl 117 WRITE(numout,*) ' frequency of float restart file nstockfl = ', nstockfl 119 118 WRITE(numout,*) ' ' 120 119 ENDIF … … 128 127 CONTAINS 129 128 SUBROUTINE flo_stp( kt ) ! Empty routine 130 WRITE(*,*) kt129 WRITE(*,*) 'flo_stp: You should not have seen this print! error?', kt 131 130 END SUBROUTINE flo_stp 132 131 #endif -
trunk/NEMO/OPA_SRC/FLO/floblk.F90
r3 r16 17 17 USE dom_oce ! ocean space and time domain 18 18 USE phycst ! physical constants 19 USE in_out_manager ! I/O manager 19 20 USE lib_mpp ! distribued memory computing library 20 21 … … 105 106 iloop = 0 106 107 222 DO jfl = 1, jpnfl 107 # if defined key_mpp108 # if defined key_mpp_mpi || defined key_mpp_shmem 108 109 IF( (iil(jfl) >= (mig(nldi)-jpizoom+1)) .AND. (iil(jfl) <= (mig(nlei)-jpizoom+1)) .AND. & 109 110 (ijl(jfl) >= (mjg(nldj)-jpjzoom+1)) .AND. (ijl(jfl) <= (mjg(nlej)-jpjzoom+1)) ) THEN … … 320 321 ! reinitialisation of the age of FLOAT 321 322 zagefl(jfl) = zagenewfl(jfl) 322 # if defined key_mpp323 # if defined key_mpp_mpi || defined key_mpp_shmem 323 324 ELSE 324 325 ! we put zgifl, zgjfl, zgkfl, zagefl … … 334 335 335 336 ! synchronisation 336 ! sum of this arrays 337 338 # if defined key_mpp 339 CALL mpp_sum( zgifl , jpnfl ) 340 CALL mpp_sum( zgjfl , jpnfl ) 341 CALL mpp_sum( zgkfl , jpnfl ) 342 CALL mpp_sum( zagefl, jpnfl ) 343 CALL mpp_sum( iil , jpnfl ) 344 CALL mpp_sum( ijl , jpnfl ) 345 # endif 337 IF( lk_mpp ) CALL mpp_sum( zgifl , jpnfl ) ! sums over the global domain 338 IF( lk_mpp ) CALL mpp_sum( zgjfl , jpnfl ) 339 IF( lk_mpp ) CALL mpp_sum( zgkfl , jpnfl ) 340 IF( lk_mpp ) CALL mpp_sum( zagefl, jpnfl ) 341 IF( lk_mpp ) CALL mpp_sum( iil , jpnfl ) 342 IF( lk_mpp ) CALL mpp_sum( ijl , jpnfl ) 346 343 347 344 ! in the case of open boundaries we need to test if the floats don't -
trunk/NEMO/OPA_SRC/FLO/flodom.F90
r3 r16 13 13 !!---------------------------------------------------------------------- 14 14 !! * Modules used 15 USE flo_oce ! ocean drifting floats16 15 USE oce ! ocean dynamics and tracers 17 16 USE dom_oce ! ocean space and time domain 17 USE flo_oce ! ocean drifting floats 18 ! USE floats 19 USE in_out_manager ! I/O manager 18 20 USE lib_mpp ! distribued memory computing library 19 21 … … 43 45 !!---------------------------------------------------------------------- 44 46 !! * Local declarations 45 LOGICAL 47 LOGICAL :: llinmesh 46 48 CHARACTER (len=21) :: clname 47 INTEGER 48 INTEGER 49 INTEGER 50 INTEGER 49 INTEGER :: ji, jj, jk ! DO loop index on 3 directions 50 INTEGER :: jfl, jfl1 ! number of floats 51 INTEGER :: inum = 11 ! logical unit for file read 52 INTEGER, DIMENSION ( jpnfl ) :: & 51 53 iimfl, ijmfl, ikmfl, & ! index mesh of floats 52 54 idomfl, ivtest, ihtest 53 REAL(wp) :: zdxab,zdyad54 REAL(wp) , DIMENSION ( jpnnewfl) :: zgifl, zgjfl, zgkfl55 REAL(wp) :: zdxab, zdyad 56 REAL(wp), DIMENSION ( jpnnewflo+1 ) :: zgifl, zgjfl, zgkfl 55 57 !!--------------------------------------------------------------------- 56 58 … … 61 63 IF(lwp) WRITE(numout,*) ' jpnfl = ',jpnfl 62 64 63 IF(ln_rst arfl) THEN65 IF(ln_rstflo) THEN 64 66 IF(lwp) WRITE(numout,*) ' float restart file read' 65 67 … … 70 72 71 73 ! read of the restart file 72 READ(inum) ( tpifl (jfl), jfl=1, jpnrst arfl), &73 ( tpjfl (jfl), jfl=1, jpnrst arfl), &74 ( tpkfl (jfl), jfl=1, jpnrst arfl), &75 ( nisobfl(jfl), jfl=1, jpnrst arfl), &76 ( ngrpfl (jfl), jfl=1, jpnrst arfl)74 READ(inum) ( tpifl (jfl), jfl=1, jpnrstflo), & 75 ( tpjfl (jfl), jfl=1, jpnrstflo), & 76 ( tpkfl (jfl), jfl=1, jpnrstflo), & 77 ( nisobfl(jfl), jfl=1, jpnrstflo), & 78 ( ngrpfl (jfl), jfl=1, jpnrstflo) 77 79 CLOSE(inum) 78 80 79 81 ! if we want a surface drift ( like PROVOR floats ) 80 82 IF( ln_argo ) THEN 81 DO jfl = 1, jpnrst arfl83 DO jfl = 1, jpnrstflo 82 84 nisobfl(jfl) = 0 83 85 END DO … … 87 89 88 90 ! It is possible to add new floats. 89 IF(lwp) WRITE(numout,*)' flo_dom:jpnfl jpnrst arfl ',jpnfl,jpnrstarfl90 IF( jpnfl > jpnrst arfl) THEN91 IF(lwp) WRITE(numout,*)' flo_dom:jpnfl jpnrstflo ',jpnfl,jpnrstflo 92 IF( jpnfl > jpnrstflo ) THEN 91 93 ! open the init file 92 94 clname='init_float' 93 95 OPEN(inum,FILE=clname,FORM='FORMATTED') 94 DO jfl = jpnrst arfl+1, jpnfl96 DO jfl = jpnrstflo+1, jpnfl 95 97 READ(inum,*) flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),jfl1 96 98 END DO … … 99 101 100 102 ! Test to find the grid point coordonate with the geographical position 101 DO jfl = jpnrst arfl+1, jpnfl103 DO jfl = jpnrstflo+1, jpnfl 102 104 ihtest(jfl) = 0 103 105 ivtest(jfl) = 0 104 106 ikmfl(jfl) = 0 105 # if defined key_mpp107 # if defined key_mpp_mpi || defined key_mpp_shmem 106 108 DO ji = MAX(nldi,2), nlei 107 109 DO jj = MAX(nldj,2), nlej … … 140 142 141 143 ! A zero in the sum of the arrays "ihtest" and "ivtest" 142 # if defined key_mpp143 CALL mpp_sum(ihtest,jpnfl ,iwork)144 CALL mpp_sum(ivtest,jpnfl ,iwork)144 # if defined key_mpp_mpi || defined key_mpp_shmem 145 CALL mpp_sum(ihtest,jpnfl) 146 CALL mpp_sum(ivtest,jpnfl) 145 147 # endif 146 DO jfl = jpnrst arfl+1, jpnfl148 DO jfl = jpnrstflo+1, jpnfl 147 149 IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1) ) THEN 148 150 IF(lwp) WRITE(numout,*) 'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH' … … 156 158 157 159 ! We compute the distance between the float and the face of the mesh 158 DO jfl = jpnrst arfl+1, jpnfl160 DO jfl = jpnrstflo+1, jpnfl 159 161 ! Made only if the float is in the domain of the processor 160 162 IF( (iimfl(jfl) >= 0) .AND. (ijmfl(jfl) >= 0) ) THEN … … 182 184 ! Translation of this distances (in meter) in indexes 183 185 184 zgifl(jfl-jpnrst arfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom)185 zgjfl(jfl-jpnrst arfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom)186 zgkfl(jfl-jpnrst arfl) = (( fsdepw(ji,jj,ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl)) &186 zgifl(jfl-jpnrstflo)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 187 zgjfl(jfl-jpnrstflo)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 188 zgkfl(jfl-jpnrstflo) = (( fsdepw(ji,jj,ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl)) & 187 189 / ( fsdepw(ji,jj,ikmfl(jfl)+1) - fsdepw(ji,jj,ikmfl(jfl) ) ) & 188 190 + (( flzz(jfl)-fsdepw(ji,jj,ikmfl(jfl)) ) *(ikmfl(jfl)+1)) & 189 191 / ( fsdepw(ji,jj,ikmfl(jfl)+1) - fsdepw(ji,jj,ikmfl(jfl)) ) 190 192 ELSE 191 zgifl(jfl-jpnrst arfl) = 0.192 zgjfl(jfl-jpnrst arfl) = 0.193 zgkfl(jfl-jpnrst arfl) = 0.193 zgifl(jfl-jpnrstflo) = 0. 194 zgjfl(jfl-jpnrstflo) = 0. 195 zgkfl(jfl-jpnrstflo) = 0. 194 196 ENDIF 195 197 END DO 196 198 197 199 ! The sum of all the arrays zgifl, zgjfl, zgkfl give 3 arrays with the positions of all the floats. 198 # if defined key_mpp 199 200 CALL mpp_sum( zgjfl, jpnnewfl ) 201 CALL mpp_sum( zgkfl, jpnnewfl ) 202 IF(lwp) WRITE(numout,*) (zgifl(jfl),jfl=1,jpnnewfl) 203 IF(lwp) WRITE(numout,*) (zgjfl(jfl),jfl=1,jpnnewfl) 204 IF(lwp) WRITE(numout,*) (zgkfl(jfl),jfl=1,jpnnewfl) 205 # endif 200 IF( lk_mpp ) THEN 201 CALL mpp_sum( zgjfl, jpnnewflo ) ! sums over the global domain 202 CALL mpp_sum( zgkfl, jpnnewflo ) 203 IF(lwp) WRITE(numout,*) (zgifl(jfl),jfl=1,jpnnewflo) 204 IF(lwp) WRITE(numout,*) (zgjfl(jfl),jfl=1,jpnnewflo) 205 IF(lwp) WRITE(numout,*) (zgkfl(jfl),jfl=1,jpnnewflo) 206 ENDIF 206 207 207 DO jfl = jpnrst arfl+1, jpnfl208 tpifl(jfl) = zgifl(jfl-jpnrst arfl)209 tpjfl(jfl) = zgjfl(jfl-jpnrst arfl)210 tpkfl(jfl) = zgkfl(jfl-jpnrst arfl)208 DO jfl = jpnrstflo+1, jpnfl 209 tpifl(jfl) = zgifl(jfl-jpnrstflo) 210 tpjfl(jfl) = zgjfl(jfl-jpnrstflo) 211 tpkfl(jfl) = zgkfl(jfl-jpnrstflo) 211 212 END DO 212 213 ENDIF … … 234 235 ivtest(jfl) = 0 235 236 ikmfl(jfl) = 0 236 # if defined key_mpp237 # if defined key_mpp_mpi || defined key_mpp_shmem 237 238 DO ji = MAX(nldi,2), nlei 238 239 DO jj = MAX(nldj,2), nlej … … 271 272 272 273 ! A zero in the sum of the arrays "ihtest" and "ivtest" 273 # if defined key_mpp 274 CALL mpp_sum(ihtest,jpnfl,iwork) 275 CALL mpp_sum(ivtest,jpnfl,iwork) 276 # endif 274 IF( lk_mpp ) CALL mpp_sum(ihtest,jpnfl) ! sums over the global domain 275 IF( lk_mpp ) CALL mpp_sum(ivtest,jpnfl) 277 276 278 277 DO jfl = 1, jpnfl … … 327 326 328 327 ! The sum of all the arrays tpifl, tpjfl, tpkfl give 3 arrays with the positions of all the floats. 329 # if defined key_mpp 330 CALL mpp_sum( tpifl , jpnfl ) 331 CALL mpp_sum( tpjfl , jpnfl ) 332 CALL mpp_sum( tpkfl , jpnfl ) 333 CALL mpp_sum( idomfl, jpnfl ) 334 # endif 328 IF( lk_mpp ) CALL mpp_sum( tpifl , jpnfl ) ! sums over the global domain 329 IF( lk_mpp ) CALL mpp_sum( tpjfl , jpnfl ) 330 IF( lk_mpp ) CALL mpp_sum( tpkfl , jpnfl ) 331 IF( lk_mpp ) CALL mpp_sum( idomfl, jpnfl ) 335 332 ENDIF 336 333 337 334 ! Print the initial positions of the floats 338 IF( .NOT. ln_rst arfl) THEN335 IF( .NOT. ln_rstflo ) THEN 339 336 ! WARNING : initial position not in the sea 340 337 DO jfl = 1, jpnfl -
trunk/NEMO/OPA_SRC/FLO/flowri.F90
r3 r16 15 15 USE dom_oce ! ocean space and time domain 16 16 USE lib_mpp ! distribued memory computing library 17 USE daymod 17 18 USE in_out_manager ! I/O manager 18 19 … … 52 53 53 54 !! * Local declarations 55 CHARACTER (len=21) :: clname 54 56 INTEGER :: inum = 11 ! temporary logical unit for restart file 55 57 INTEGER :: & … … 62 64 REAL(wp) :: zafl,zbfl,zcfl,zdtj 63 65 REAL(wp) :: zxxu, zxxu_01,zxxu_10, zxxu_11 64 REAL(wp) , DIMENSION ( jpk , jpnfl) :: ztemp, zsal 65 66 CHARACTER (len=21) :: clname 66 REAL(wp), DIMENSION (jpk,jpnfl) :: ztemp, zsal 67 67 !!--------------------------------------------------------------------- 68 68 … … 86 86 IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,nwritefl 87 87 ENDIF 88 zdtj = rdt /86400.88 zdtj = rdt / 86400. !!bug use of 86400 instead of the phycst parameter 89 89 90 90 ! translation of index position in geographical position 91 91 92 DO jfl = 1, jpnfl 93 iafl = INT (tpifl(jfl)) 94 ibfl = INT (tpjfl(jfl)) 95 icfl = INT (tpkfl(jfl)) 96 iafln = NINT(tpifl(jfl)) 97 ibfln = NINT(tpjfl(jfl)) 98 ia1fl = iafl+1 99 ib1fl = ibfl+1 100 ic1fl = icfl+1 101 zafl = tpifl(jfl) - FLOAT(iafl) 102 zbfl = tpjfl(jfl) - FLOAT(ibfl) 103 zcfl = tpkfl(jfl) - FLOAT(icfl) 104 # if defined key_mpp 105 IF( (iafl >= (mig(nldi)-jpizoom+1)) .AND. (iafl <= (mig(nlei)-jpizoom+1)) .AND. & 106 ( ibfl >= (mjg(nldj)-jpjzoom+1)) .AND. (ibfl <= (mjg(nlej)-jpjzoom+1)) ) THEN 107 108 ! local index 109 110 iafloc = iafl -(mig(1)-jpizoom+1) + 1 111 ibfloc = ibfl -(mjg(1)-jpjzoom+1) + 1 92 IF( lk_mpp ) THEN 93 DO jfl = 1, jpnfl 94 iafl = INT ( tpifl(jfl) ) 95 ibfl = INT ( tpjfl(jfl) ) 96 icfl = INT ( tpkfl(jfl) ) 97 iafln = NINT( tpifl(jfl) ) 98 ibfln = NINT( tpjfl(jfl) ) 99 ia1fl = iafl + 1 100 ib1fl = ibfl + 1 101 ic1fl = icfl + 1 102 zafl = tpifl(jfl) - FLOAT( iafl ) 103 zbfl = tpjfl(jfl) - FLOAT( ibfl ) 104 zcfl = tpkfl(jfl) - FLOAT( icfl ) 105 IF( iafl >= mig(nldi)-jpizoom+1 .AND. iafl <= mig(nlei)-jpizoom+1 .AND. & 106 & ibfl >= mjg(nldj)-jpjzoom+1 .AND. ibfl <= mjg(nlej)-jpjzoom+1 ) THEN 107 108 ! local index 109 110 iafloc = iafl -(mig(1)-jpizoom+1) + 1 111 ibfloc = ibfl -(mjg(1)-jpjzoom+1) + 1 112 ia1floc = iafloc + 1 113 ib1floc = ibfloc + 1 114 115 flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 116 & + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 117 flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 118 & + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 119 flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 120 121 ! Change by Alexandra Bozec et Jean-Philippe Boulanger 122 ! We save the instantaneous profile of T and S of the column 123 ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 124 ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 125 ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 126 zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 127 ELSE 128 flxx(jfl) = 0. 129 flyy(jfl) = 0. 130 flzz(jfl) = 0. 131 ztemp(1:jpk,jfl) = 0. 132 zsal (1:jpk,jfl) = 0. 133 ENDIF 134 END DO 135 136 CALL mpp_sum( flxx, jpnfl ) ! sums over the global domain 137 CALL mpp_sum( flyy, jpnfl ) 138 CALL mpp_sum( flzz, jpnfl ) 139 ! these 2 lines have accendentaly been removed from ATL6-V8 run hence 140 ! giving 0 salinity and temperature on the float trajectory 141 CALL mpp_sum( ztemp, jpk*jpnfl ) 142 CALL mpp_sum( zsal , jpk*jpnfl ) 143 144 ELSE 145 DO jfl = 1, jpnfl 146 iafl = INT (tpifl(jfl)) 147 ibfl = INT (tpjfl(jfl)) 148 icfl = INT (tpkfl(jfl)) 149 iafln = NINT(tpifl(jfl)) 150 ibfln = NINT(tpjfl(jfl)) 151 ia1fl = iafl+1 152 ib1fl = ibfl+1 153 ic1fl = icfl+1 154 zafl = tpifl(jfl) - FLOAT(iafl) 155 zbfl = tpjfl(jfl) - FLOAT(ibfl) 156 zcfl = tpkfl(jfl) - FLOAT(icfl) 157 iafloc = iafl 158 ibfloc = ibfl 112 159 ia1floc = iafloc + 1 113 160 ib1floc = ibfloc + 1 … … 118 165 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 119 166 flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 120 167 !ALEX 168 ! Astuce pour ne pas avoir des flotteurs qui se baladent sur IDL 169 zxxu_11 = glamt(iafloc ,ibfloc ) 170 zxxu_10 = glamt(iafloc ,ib1floc) 171 zxxu_01 = glamt(ia1floc,ibfloc ) 172 zxxu = glamt(ia1floc,ib1floc) 173 174 IF( iafloc == 52 ) zxxu_10 = -181 175 IF( iafloc == 52 ) zxxu_11 = -181 176 flxx(jfl)=(1.-zafl)*(1.-zbfl)* zxxu_11 + (1.-zafl)* zbfl * zxxu_10 & 177 + zafl *(1.-zbfl)* zxxu_01 + zafl * zbfl * zxxu 178 !ALEX 121 179 ! Change by Alexandra Bozec et Jean-Philippe Boulanger 122 180 ! We save the instantaneous profile of T and S of the column 123 ! ztemp(jfl)=tn(iafloc,ibfloc,icfl)124 ! zsal(jfl)=sn(iafloc,ibfloc,icfl)181 ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 182 ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 125 183 ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 126 zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 127 ELSE 128 flxx(jfl) = 0. 129 flyy(jfl) = 0. 130 flzz(jfl) = 0. 131 ztemp(1:jpk,jfl) = 0. 132 zsal (1:jpk,jfl) = 0. 133 ENDIF 134 # else 135 iafloc = iafl 136 ibfloc = ibfl 137 ia1floc = iafloc + 1 138 ib1floc = ibfloc + 1 139 ! 140 flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 141 + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 142 flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 143 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 144 flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 145 !ALEX 146 ! Astuce pour ne pas avoir des flotteurs qui se baladent sur IDL 147 zxxu_11 = glamt(iafloc ,ibfloc ) 148 zxxu_10 = glamt(iafloc ,ib1floc) 149 zxxu_01 = glamt(ia1floc,ibfloc ) 150 zxxu = glamt(ia1floc,ib1floc) 151 152 IF( iafloc == 52 ) zxxu_10 = -181 153 IF( iafloc == 52 ) zxxu_11 = -181 154 flxx(jfl)=(1.-zafl)*(1.-zbfl)* zxxu_11 + (1.-zafl)* zbfl * zxxu_10 & 155 + zafl *(1.-zbfl)* zxxu_01 + zafl * zbfl * zxxu 156 !ALEX 157 ! Change by Alexandra Bozec et Jean-Philippe Boulanger 158 ! We save the instantaneous profile of T and S of the column 159 ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 160 ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 161 ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 162 zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 163 # endif 164 END DO 165 166 # if defined key_mpp 167 CALL mpp_sum( flxx, jpnfl ) 168 CALL mpp_sum( flyy, jpnfl ) 169 CALL mpp_sum( flzz, jpnfl ) 170 ! these 2 lines have accendentaly been removed from ATL6-V8 run hence 171 ! giving 0 salinity and temperature on the float trajectory 172 CALL mpp_sum( ztemp, jpk*jpnfl ) 173 CALL mpp_sum( zsal , jpk*jpnfl ) 174 175 # endif 184 zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 185 END DO 186 ENDIF 187 176 188 ! 177 189 WRITE(numflo) flxx,flyy,flzz,nisobfl,ngrpfl,ztemp,zsal, FLOAT(ndastp) … … 187 199 ! iafln=NINT(tpifl(jfl)) 188 200 ! ibfln=NINT(tpjfl(jfl)) 189 !# if defined key_mpp 201 !# if defined key_mpp_mpi || defined key_mpp_shmem 190 202 ! IF ( (iafl >= (mig(nldi)-jpizoom+1)) .AND. 191 203 ! $ (iafl <= (mig(nlei)-jpizoom+1)) .AND. … … 206 218 ! ztemp(jfl)=tn(iafloc,ibfloc,jk) 207 219 ! zsal(jfl)=sn(iaflo!,ibfloc,jk) 208 !# if defined key_mpp 220 !# if defined key_mpp_mpi || defined key_mpp_shmem 209 221 ! ELSE 210 222 ! ztemp(jfl) = 0. … … 214 226 !! ... next float 215 227 ! END DO 216 !#if defined key_mpp 217 ! CALL mpp_sum( ztemp, jpnfl ) 218 ! CALL mpp_sum( zsal , jpnfl ) 219 !# endif 228 ! IF( lk_mpp ) CALL mpp_sum( ztemp, jpnfl ) 229 ! IF( lk_mpp ) CALL mpp_sum( zsal , jpnfl ) 230 ! 220 231 ! IF (lwp) THEN 221 232 ! WRITE(numflo) ztemp, zsal … … 268 279 ! Compute the number of trajectories for each processor 269 280 ! 270 # if defined key_mpp 271 DO jfl = 1, jpnfl 272 IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND. & 273 ( INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND. & 274 ( INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND. & 275 ( INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN 276 iproc(narea) = iproc(narea)+1 277 ENDIF 278 END DO 279 CALL mpp_sum( iproc, jpnij ) 280 ! 281 IF(lwp) THEN 282 WRITE(numout,*) 'DATE',adatrj 283 DO jpn = 1, jpnij 284 IF( iproc(jpn) /= 0 ) THEN 285 WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iproc(jpn), 'trajectories.' 281 IF( lk_mpp ) THEN 282 DO jfl = 1, jpnfl 283 IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND. & 284 &(INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND. & 285 &(INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND. & 286 &(INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN 287 iproc(narea) = iproc(narea)+1 286 288 ENDIF 287 289 END DO 288 ENDIF 289 # endif 290 CALL mpp_sum( iproc, jpnij ) 291 ! 292 IF(lwp) THEN 293 WRITE(numout,*) 'DATE',adatrj 294 DO jpn = 1, jpnij 295 IF( iproc(jpn) /= 0 ) THEN 296 WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iproc(jpn), 'trajectories.' 297 ENDIF 298 END DO 299 ENDIF 300 ENDIF 290 301 ENDIF 291 302 -
trunk/NEMO/OPA_SRC/SOL/sol_oce.F90
r3 r16 16 16 17 17 IMPLICIT NONE 18 PRIVATE 18 19 19 !!----------------------------------- -----------------------------------20 !!----------------------------------- 20 21 !! elliptic solver: SOR, PCG or FETI 21 !! ---------------------------------- -----------------22 INTEGER :: & !!!namsol elliptic solver / island / free surface23 nsolv = 1 , & ! = 1/2/3 type of elliptic solver24 nmax = 800 , & ! maximum of iterations for the solver25 nmisl = 4000 ! maximum pcg iterations for island22 !! ---------------------------------- 23 INTEGER , PUBLIC :: & !!: namsol elliptic solver / island / free surface 24 nsolv = 1 , & !: = 1/2/3 type of elliptic solver 25 nmax = 800 , & !: maximum of iterations for the solver 26 nmisl = 4000 !: maximum pcg iterations for island 26 27 27 REAL(wp) :: & !!!namsol elliptic solver / island / free surface28 eps = 1.e-6_wp , & ! absolute precision of the solver29 sor = 1.76_wp , & ! optimal coefficient for sor solver30 epsisl = 1.e-10_wp, & ! absolute precision on stream function solver31 rnu = 1.0_wp ! strength of the additional force used in free surface28 REAL(wp), PUBLIC :: & !!: namsol elliptic solver / island / free surface 29 eps = 1.e-6_wp , & !: absolute precision of the solver 30 sor = 1.76_wp , & !: optimal coefficient for sor solver 31 epsisl = 1.e-10_wp, & !: absolute precision on stream function solver 32 rnu = 1.0_wp !: strength of the additional force used in free surface 32 33 33 INTEGER :: &34 ncut, & ! indicator of solver convergence35 niter ! number of iteration done by the solver34 CHARACTER(len=1), PUBLIC :: & !: 35 c_solver_pt = 'T' !: nature of grid-points T (S) for free surface case 36 ! ! F (G) for rigid-lid case 36 37 37 REAL(wp) :: & 38 epsr, & ! relative precision for SOR & PCG solvers 39 epsilo, & ! precision for the FETI solver 40 rnorme, res, & ! intermediate modulus, solver residu 41 alph, & ! coefficient =(gcr,gcr)/(gcx,gccd) 42 beta, & ! coefficient =(rn+1,rn+1)/(rn,rn) 43 radd, & ! coefficient =(gccd,gcdes) 44 rr ! coefficient =(rn,rn) 38 INTEGER , PUBLIC :: & !: 39 ncut, & !: indicator of solver convergence 40 niter !: number of iteration done by the solver 45 41 46 REAL(wp), DIMENSION(jpi,jpj,4) :: & 47 gcp ! barotropic matrix extra-diagonal elements 42 REAL(wp), PUBLIC :: & !: 43 epsr, & !: relative precision for SOR & PCG solvers 44 epsilo, & !: precision for the FETI solver 45 rnorme, res, & !: intermediate modulus, solver residu 46 alph, & !: coefficient =(gcr,gcr)/(gcx,gccd) 47 beta, & !: coefficient =(rn+1,rn+1)/(rn,rn) 48 radd, & !: coefficient =(gccd,gcdes) 49 rr !: coefficient =(rn,rn) 48 50 49 REAL(wp), DIMENSION(jpi,jpj) :: & 50 gcx, gcxb, & ! now, before solution of the elliptic equation 51 gcdprc, & ! inverse diagonal preconditioning matrix 52 gcdmat, & ! diagonal preconditioning matrix 53 gcb, & ! second member of the barotropic linear system 54 gcr, & ! residu =b-a.x 55 gcdes, & ! vector descente 56 gccd ! vector such that ca.gccd=a.d (ca-1=gcdprc) 51 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,4) :: & !: 52 gcp !: barotropic matrix extra-diagonal elements 53 54 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 55 gcx, gcxb, & !: now, before solution of the elliptic equation 56 gcdprc, & !: inverse diagonal preconditioning matrix 57 gcdmat, & !: diagonal preconditioning matrix 58 gcb, & !: second member of the barotropic linear system 59 gcr, & !: residu =b-a.x 60 gcdes, & !: vector descente 61 gccd !: vector such that ca.gccd=a.d (ca-1=gcdprc) 57 62 58 63 #if defined key_feti … … 67 72 !! malistin() : concatened list of interface nodes 68 73 69 INTEGER :: nim,nxm, &74 INTEGER, PUBLIC :: nim,nxm, & 70 75 malxm,malim,malxmax,malimax, & 71 76 nifmat,njfmat,nelem,npe,matopo, & … … 85 90 madwork 86 91 87 INTEGER :: mfet(jpi*jpj+2*jpi+2*jpj+51)92 INTEGER, PUBLIC :: mfet(jpi*jpj+2*jpi+2*jpj+51) 88 93 89 REAL(wp) :: wfeti(jpj*jpi*jpi+13*jpi*jpj+19*(jpi+jpj) & 94 REAL(wp), PUBLIC :: & !: 95 wfeti(jpj*jpi*jpi+13*jpi*jpj+19*(jpi+jpj) & 90 96 +4*jpnij+33 & 91 97 +2*(jpi+jpj)*(jpnij-jpni)*jpi & … … 94 100 +3*(jpnij-jpnj+jperio)*jpj) 95 101 96 REAL(wp) :: res2, rcompt102 REAL(wp), PUBLIC :: res2, rcompt 97 103 98 104 #endif -
trunk/NEMO/OPA_SRC/SOL/solfet.F90
r3 r16 33 33 !! Solve the ellipic equation for the barotropic stream function 34 34 !! system (default option) or the transport divergence system 35 !! ( "key_dynspg_fsc") using a Finite Elements Tearing &35 !! (lk_dynspg_fsc=T) using a Finite Elements Tearing and 36 36 !! Interconnecting (FETI) approach. 37 37 !! In the former case, the barotropic stream function trend has a … … 142 142 CALL feti_vmov( noeuds, wfeti(miax), gcx ) 143 143 144 ! boundary conditions !!bug ??? check arguments... 145 # if defined key_dynspg_fsc 146 # if defined key_mpp 147 ! Mpp: export boundary values to neighbouring processors 148 CALL lbc_lnk( gcx, 'S', 1. ) 149 # else 150 ! mono- or macro-tasking: W-point, >0, 2D array, no slab 151 IF( nperio /= 0 ) THEN 152 CALL lbc_lnk( gcx, 'T', 1. ) 153 ENDIF 154 # endif 155 # else 156 # if defined key_mpp 157 ! Mpp: export boundary values to neighbouring processors 158 CALL lbc_lnk( gcx, 'G', 1. ) 159 # else 160 ! mono- or macro-tasking: W-point, >0, 2D array, no slab 161 IF( nperio /= 0 ) THEN 162 CALL lbc_lnk( gcx, 'F', 1. ) 163 ENDIF 164 # endif 165 # endif 144 CALL lbc_lnk( gcx, c_solver_pt, 1. ) ! lateral boundary condition 166 145 167 146 END SUBROUTINE sol_fet -
trunk/NEMO/OPA_SRC/SOL/solisl.F90
r3 r16 36 36 37 37 !! * Shared module variables 38 LOGICAL, PUBLIC :: & 39 l_isl = .TRUE. ! 'key_islands' flag 38 LOGICAL, PUBLIC, PARAMETER :: l_isl = .TRUE. !: 'key_islands' flag 40 39 41 40 !! * module variable … … 157 156 zwb(jpi,:) = 0.e0 158 157 ENDIF 159 # if defined key_mpp 160 ! Mpp: export boundary values to neighboring processors 161 CALL lbc_lnk( zwb, 'G', 1. ) 162 # endif 158 IF( lk_mpp ) CALL lbc_lnk( zwb, 'G', 1. ) 163 159 164 160 165 161 ! 1. Initialization for the search of island grid-points 166 162 ! ------------------------------------------------------ 167 # if defined key_mpp 168 169 ! Mpp : The overlap region are not taken into account 170 ! (islands bondaries are searched over subdomain only) 171 iista = 1 + jpreci 172 iiend = nlci - jpreci 173 ijsta = 1 + jprecj 174 ijend = nlcj - jprecj 175 ijstm1= 1 + jprecj 176 ijenm1= nlcj - jprecj 177 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 163 164 IF( lk_mpp ) THEN 165 166 ! Mpp : The overlap region are not taken into account 167 ! (islands bondaries are searched over subdomain only) 168 iista = 1 + jpreci 169 iiend = nlci - jpreci 170 ijsta = 1 + jprecj 171 ijend = nlcj - jprecj 172 ijstm1= 1 + jprecj 173 ijenm1= nlcj - jprecj 174 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 175 iista = 1 176 ENDIF 177 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 178 iiend = nlci 179 ENDIF 180 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 181 ijsta = 1 182 ijstm1 = 2 183 ENDIF 184 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 185 ijend = nlcj 186 ijenm1 = nlcj-1 187 ENDIF 188 IF( npolj == 3 .OR. npolj == 4 ) THEN 189 ijend = nlcj-2 190 ijenm1 = nlcj-2 191 ENDIF 192 ELSE 193 ! mono- or macro-tasking environnement: full domain scan 178 194 iista = 1 179 ENDIF 180 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 181 iiend = nlci 182 ENDIF 183 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 195 iiend = jpi 184 196 ijsta = 1 185 197 ijstm1 = 2 186 ENDIF 187 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 188 ijend = nlcj 189 ijenm1 = nlcj-1 190 ENDIF 191 IF( npolj == 3 .OR. npolj == 4 ) THEN 192 ijend = nlcj-2 193 ijenm1 = nlcj-2 194 ENDIF 195 # else 196 197 ! mono- or macro-tasking environnement: full domain scan 198 iista = 1 199 iiend = jpi 200 ijsta = 1 201 ijstm1 = 2 202 IF( nperio == 3 .OR. nperio == 4 ) THEN 203 ijend = jpj-2 204 ijenm1 = jpj-2 205 ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN 206 ijend = jpj-1 207 ijenm1 = jpj-1 208 ELSE 209 ijend = jpj 210 ijenm1 = jpj-1 211 ENDIF 212 # endif 198 IF( nperio == 3 .OR. nperio == 4 ) THEN 199 ijend = jpj-2 200 ijenm1 = jpj-2 201 ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN 202 ijend = jpj-1 203 ijenm1 = jpj-1 204 ELSE 205 ijend = jpj 206 ijenm1 = jpj-1 207 ENDIF 208 ENDIF 213 209 214 210 … … 247 243 inilt = inilt + indil(jj) 248 244 END DO 249 # if defined key_mpp 250 CALL mpp_sum( inilt ) 251 # endif 245 IF( lk_mpp ) CALL mpp_sum( inilt ) ! sum over the global domain 246 252 247 IF( inilt == 0 ) THEN 253 248 IF(lwp) THEN … … 255 250 WRITE(numout,*) ' change parameter.h' 256 251 ENDIF 257 STOP 'isldom' 252 STOP 'isldom' !cr replace by nstop 258 253 ENDIF 259 254 … … 381 376 ! Take account of redundant points 382 377 383 # if defined key_mpp 384 CALL mpp_sum( ip ) 385 # endif 378 IF( lk_mpp ) CALL mpp_sum( ip ) ! sum over the global domain 386 379 387 380 IF( ip > jpnisl ) THEN … … 391 384 WRITE(numout,*) ' change parameter.h' 392 385 ENDIF 393 STOP 'isldom' 386 STOP 'isldom' !cr => nstop 394 387 ENDIF 395 388 … … 409 402 410 403 inilt = isrchne( jpij, zwb(1,1), 1, 0. ) 411 # if defined key_mpp 412 CALL mpp_min( inilt ) 413 # endif 404 IF( lk_mpp ) CALL mpp_min( inilt ) ! min over the global domain 414 405 415 406 IF( inilt /= jpij+1 ) THEN … … 426 417 ! ---------------------------------------- 427 418 428 CALL isl pri419 CALL isl_pri 429 420 430 421 … … 432 423 ! ------------------------------------------------------- 433 424 434 CALL isl pth425 CALL isl_pth 435 426 436 427 END SUBROUTINE isl_dom … … 466 457 ipe = mnisl(3,jni) 467 458 ipw = mnisl(4,jni) 468 # if defined key_mpp 469 CALL mpp_sum( ip )470 CALL mpp_sum( ipn )471 CALL mpp_sum( ips )472 CALL mpp_sum( ipe )473 CALL mpp_sum( ipw )474 # endif 459 IF( lk_mpp ) THEN 460 CALL mpp_sum( ip ) ! sums over the global domain 461 CALL mpp_sum( ipn ) 462 CALL mpp_sum( ips ) 463 CALL mpp_sum( ipe ) 464 CALL mpp_sum( ipw ) 465 ENDIF 475 466 IF(lwp) THEN 476 467 WRITE(numout,9000) jni … … 484 475 END DO 485 476 486 ! FORMAT 487 477 ! FORMAT !!cr => no more format 488 478 9000 FORMAT(/, /, 'island number= ', i2 ) 489 479 9010 FORMAT(/, 'npil=',i4,' npn=',i3,' nps=',i3,' npe=',i3,' npw=',i3 ) … … 514 504 !!---------------------------------------------------------------------- 515 505 !! * Local declarations 516 INTEGER :: j i, jj, jni, jii, jnp ! dummy loop indices517 INTEGER :: ii, ij 506 INTEGER :: jni, jii, jnp ! dummy loop indices 507 INTEGER :: ii, ij ! temporary integers 518 508 !!---------------------------------------------------------------------- 519 509 … … 587 577 REAL(wp), DIMENSION(jpi,jpj) :: zlamt, zphit 588 578 REAL(wp), DIMENSION(jpi,jpj,2) :: zwx 589 # if defined key_mpp590 579 REAL(wp), DIMENSION(jpisl*jpisl) :: ztab 591 # endif592 580 !!---------------------------------------------------------------------- 593 581 … … 674 662 675 663 END DO 676 # if defined key_mpp 677 DO jnj=1,jpisl 678 DO jni=1,jpisl 679 ztab(jni+(jnj-1)*jpisl) = aisl(jni,jnj) 680 END DO 681 END DO 682 683 CALL mpp_sum( ztab, jpisl*jpisl ) 684 !! CALL mpp_sum( aisl, jpisl*jpisl ) 685 # endif 664 IF( lk_mpp ) THEN 665 DO jnj = 1, jpisl 666 DO jni = 1, jpisl 667 ztab(jni+(jnj-1)*jpisl) = aisl(jni,jnj) 668 END DO 669 END DO 670 CALL mpp_sum( ztab, jpisl*jpisl ) ! sum over the global domain 671 !! CALL mpp_sum( aisl, jpisl*jpisl ) 672 ENDIF 686 673 687 674 ! 1.3 Control print … … 775 762 REAL(wp) :: zep(jpisl), zlamt(jpi,jpj), zphit(jpi,jpj), zdept(1), zprec(4) 776 763 REAL(wp) :: zdate0, zdt 777 # if defined key_mpp 764 REAL(wp) :: t2p1(jpi,1,1) 778 765 INTEGER :: iloc 779 # endif780 766 !!---------------------------------------------------------------------- 781 767 … … 907 893 ! Right hand side of the streamfunction equation 908 894 909 # if defined key_mpp 910 911 ! north fold treatment 912 IF( npolj == 3 .OR. npolj == 5) iloc=jpiglo-(nimpp-1+nimppt(nono+1)-1) 913 IF( npolj == 4 .OR. npolj == 6) iloc=jpiglo-2*(nimpp-1) 914 t2p1(:,1,1) = 0.e0 915 ! north and south grid-points 916 DO jii = 1, 2 917 DO jnp = 1, mnisl(jii,jni) 918 ii = miisl(jnp,jii,jni) 919 ij = mjisl(jnp,jii,jni) 920 IF( ( npolj == 3 .OR. npolj == 4 ) .AND. & 921 ( ij == nlcj-1 .AND. jii == 1) ) THEN 922 iju=iloc-ii+1 923 t2p1(iju,1,1) = t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 924 ELSEIF( ( npolj == 5 .OR. npolj == 6 ) .AND. & 925 ( ij == nlcj-1 .AND. jii == 1) ) THEN 926 iju=iloc-ii 927 gcb(ii,ij) = gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 928 t2p1(iju,1,1) = t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 929 ELSE 930 gcb(ii,ij-jii+1) = gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 931 ENDIF 932 END DO 933 END DO 934 935 ! east and west grid-points 936 937 DO jii = 3, 4 938 DO jnp = 1, mnisl(jii,jni) 939 ii = miisl(jnp,jii,jni) 940 ij = mjisl(jnp,jii,jni) 941 gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 942 END DO 943 END DO 944 CALL mpplnks( gcb ) 945 946 # else 947 948 ! north and south grid-points 949 DO jii = 1, 2 950 DO jnp = 1, mnisl(jii,jni) 951 ii = miisl(jnp,jii,jni) 952 ij = mjisl(jnp,jii,jni) 953 IF( ( nperio == 3 .OR. nperio == 4 ) .AND. & 954 ( ij == jpj-1 .AND. jii == 1) ) THEN 955 gcb(jpi-ii+1,ij-1) = gcb(jpi-ii+1,ij-1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 956 ELSEIF( ( nperio == 5 .OR. nperio == 6 ) .AND. & 957 ( ij == jpj-1 .AND. jii == 1) ) THEN 958 gcb(ii,ij) = gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 959 gcb(jpi-ii,ij) = gcb(jpi-ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 960 ELSE 961 gcb(ii,ij-jii+1) = gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 962 ENDIF 963 END DO 964 END DO 965 966 ! east and west grid-points 967 DO jii = 3, 4 968 DO jnp = 1, mnisl(jii,jni) 969 ii = miisl(jnp,jii,jni) 970 ij = mjisl(jnp,jii,jni) 971 IF( bmask(ii-jii+3,ij) /= 0. ) THEN 895 IF( lk_mpp ) THEN 896 897 ! north fold treatment 898 IF( npolj == 3 .OR. npolj == 5) iloc=jpiglo-(nimpp-1+nimppt(nono+1)-1) 899 IF( npolj == 4 .OR. npolj == 6) iloc=jpiglo-2*(nimpp-1) 900 t2p1(:,1,1) = 0.e0 901 ! north and south grid-points 902 DO jii = 1, 2 903 DO jnp = 1, mnisl(jii,jni) 904 ii = miisl(jnp,jii,jni) 905 ij = mjisl(jnp,jii,jni) 906 IF( ( npolj == 3 .OR. npolj == 4 ) .AND. & 907 ( ij == nlcj-1 .AND. jii == 1) ) THEN 908 iju=iloc-ii+1 909 t2p1(iju,1,1) = t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 910 ELSEIF( ( npolj == 5 .OR. npolj == 6 ) .AND. & 911 ( ij == nlcj-1 .AND. jii == 1) ) THEN 912 iju=iloc-ii 913 gcb(ii,ij) = gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 914 t2p1(iju,1,1) = t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 915 ELSE 916 gcb(ii,ij-jii+1) = gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 917 ENDIF 918 END DO 919 END DO 920 921 ! east and west grid-points 922 923 DO jii = 3, 4 924 DO jnp = 1, mnisl(jii,jni) 925 ii = miisl(jnp,jii,jni) 926 ij = mjisl(jnp,jii,jni) 972 927 gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 973 ELSE 974 975 ! east-west cyclic boundary conditions 976 IF( ii-jii+3 == 1 ) THEN 977 gcb(jpim1,ij) = gcb(jpim1,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 928 END DO 929 END DO 930 931 IF( lk_mpp ) CALL mpplnks( gcb ) !!bug ? should use an lbclnk ? is it possible? 932 933 ELSE 934 935 ! north and south grid-points 936 DO jii = 1, 2 937 DO jnp = 1, mnisl(jii,jni) 938 ii = miisl(jnp,jii,jni) 939 ij = mjisl(jnp,jii,jni) 940 IF( ( nperio == 3 .OR. nperio == 4 ) .AND. & 941 ( ij == jpj-1 .AND. jii == 1) ) THEN 942 gcb(jpi-ii+1,ij-1) = gcb(jpi-ii+1,ij-1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 943 ELSEIF( ( nperio == 5 .OR. nperio == 6 ) .AND. & 944 ( ij == jpj-1 .AND. jii == 1) ) THEN 945 gcb(ii,ij) = gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 946 gcb(jpi-ii,ij) = gcb(jpi-ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 947 ELSE 948 gcb(ii,ij-jii+1) = gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 978 949 ENDIF 979 ENDIF 980 END DO 981 END DO 982 983 # endif 950 END DO 951 END DO 952 953 ! east and west grid-points 954 DO jii = 3, 4 955 DO jnp = 1, mnisl(jii,jni) 956 ii = miisl(jnp,jii,jni) 957 ij = mjisl(jnp,jii,jni) 958 IF( bmask(ii-jii+3,ij) /= 0. ) THEN 959 gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 960 ELSE 961 ! east-west cyclic boundary conditions 962 IF( ii-jii+3 == 1 ) THEN 963 gcb(jpim1,ij) = gcb(jpim1,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 964 ENDIF 965 ENDIF 966 END DO 967 END DO 968 ENDIF 984 969 985 970 ! Preconditioned right hand side and absolute precision … … 1011 996 END DO 1012 997 END DO 1013 # if defined key_mpp 1014 CALL mpp_sum( rnorme ) 1015 # endif 998 IF( lk_mpp ) CALL mpp_sum( rnorme ) ! sum over the global domain 999 1016 1000 IF(lwp) WRITE(numout,*) 'rnorme ', rnorme 1017 1001 epsr = epsisl * epsisl * rnorme … … 1070 1054 END DO 1071 1055 ENDIF 1072 # if defined key_mpp 1073 CALL lbc_lnk( bsfisl(:,:,jni), 'G', 1. ) 1074 # endif 1056 IF( lk_mpp ) CALL lbc_lnk( bsfisl(:,:,jni), 'G', 1. ) ! link at G-point 1075 1057 1076 1058 … … 1212 1194 END DO 1213 1195 END DO 1214 # if defined key_mpp 1215 ! Mpp : global sum to obtain global dot from local ones 1216 CALL mpp_sum( bisl, jpisl ) 1217 # endif 1196 IF( lk_mpp ) CALL mpp_sum( bisl, jpisl ) ! sum over the global domain 1197 1218 1198 DO jni = 1, jpisl ! Island stream function trend 1219 1199 visl(jni) = 0.e0 … … 1270 1250 zfact = 1.e-6 * bsfn(miisl(1,0,jni),mjisl(1,0,jni)) 1271 1251 ENDIF 1272 # if defined key_mpp 1273 CALL mpp_isl( zfact ) 1274 # endif 1252 IF( lk_mpp ) CALL mpp_isl( zfact ) 1253 1275 1254 IF(lwp) WRITE(numisp,9300) kt, jni, zfact, visl(jni) 1276 1255 IF( MOD( kt, nwrite ) == 0 .OR. kindic < 0 & … … 1293 1272 !! Default option Empty module 1294 1273 !!---------------------------------------------------------------------- 1295 LOGICAL, PUBLIC :: l_isl = .FALSE. !'key_islands' flag1274 LOGICAL, PUBLIC, PARAMETER :: l_isl = .FALSE. !: 'key_islands' flag 1296 1275 CONTAINS 1297 1276 SUBROUTINE isl_dom ! Empty routine … … 1304 1283 END SUBROUTINE isl_dyn_spg 1305 1284 SUBROUTINE isl_stp_ctl( kt, kindic ) ! Empty routine 1306 WRITE(*,*) kt, kindic ! no compilation warning1285 WRITE(*,*) 'isl_stp_ctl: You should not have seen this print! error?', kt, kindic 1307 1286 END SUBROUTINE isl_stp_ctl 1308 1287 #endif -
trunk/NEMO/OPA_SRC/SOL/solisl_fdir.h90
r3 r16 109 109 110 110 END DO 111 # if defined key_mpp 112 CALL mpp_sum( aisl, jpisl*jpisl ) 113 # endif 111 IF( lk_mpp ) CALL mpp_sum( aisl, jpisl*jpisl ) ! sum over the global domain 114 112 115 113 ! 1.3 Control print 116 117 114 IF(lwp) THEN 118 115 WRITE(numout,*) … … 296 293 ! 1.2 Right hand side of the stream FUNCTION equation 297 294 298 # if defined key_mpp 299 300 ! north fold treatment 301 IF( npolj == 3 ) iloc = jpiglo -(nimpp-1+nimppt(nono+1)-1) 302 IF( npolj == 4 ) iloc = jpiglo - 2*(nimpp-1) 303 t2p1(:,1,1) = 0. 304 ! north and south grid-points 305 DO jii = 1, 2 306 DO jnp = 1, mnisl(jii,jni) 307 ii = miisl(jnp,jii,jni) 308 ij = mjisl(jnp,jii,jni) 309 IF( ( npolj == 3 .OR. npolj == 4 ) .AND. ( ij == nlcj-1 .AND. jii == 1) ) THEN 310 iju=iloc-ii+1 311 t2p1(iju,1,1) = t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 312 ELSE 313 gcb(ii,ij-jii+1) = gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 314 ENDIF 315 END DO 316 END DO 317 318 ! east and west grid-points 319 320 DO jii = 3, 4 321 DO jnp = 1, mnisl(jii,jni) 322 ii = miisl(jnp,jii,jni) 323 ij = mjisl(jnp,jii,jni) 324 gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 325 END DO 326 END DO 327 CALL mpplnks( gcb ) 328 329 # else 330 331 ! north and south grid-points 332 DO jii = 1, 2 333 DO jnp = 1, mnisl(jii,jni) 334 ii = miisl(jnp,jii,jni) 335 ij = mjisl(jnp,jii,jni) 336 IF( ( nperio == 3 .OR. nperio == 4 ) .AND. ( ij == jpj-1 .AND. jii == 1) ) THEN 337 gcb(jpi-ii+1,ij-1) = gcb(jpi-ii+1,ij-1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 338 ELSE 339 gcb(ii,ij-jii+1) = gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 340 ENDIF 341 END DO 342 END DO 343 344 ! east and west grid-points 345 DO jii = 3, 4 346 DO jnp = 1, mnisl(jii,jni) 347 ii = miisl(jnp,jii,jni) 348 ij = mjisl(jnp,jii,jni) 349 IF( bmask(ii-jii+3,ij) /= 0. ) THEN 295 IF( lk_mpp ) THEN 296 ! north fold treatment 297 IF( npolj == 3 ) iloc = jpiglo -(nimpp-1+nimppt(nono+1)-1) 298 IF( npolj == 4 ) iloc = jpiglo - 2*(nimpp-1) 299 t2p1(:,1,1) = 0. 300 ! north and south grid-points 301 DO jii = 1, 2 302 DO jnp = 1, mnisl(jii,jni) 303 ii = miisl(jnp,jii,jni) 304 ij = mjisl(jnp,jii,jni) 305 IF( ( npolj == 3 .OR. npolj == 4 ) .AND. ( ij == nlcj-1 .AND. jii == 1) ) THEN 306 iju=iloc-ii+1 307 t2p1(iju,1,1) = t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 308 ELSE 309 gcb(ii,ij-jii+1) = gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 310 ENDIF 311 END DO 312 END DO 313 314 ! east and west grid-points 315 316 DO jii = 3, 4 317 DO jnp = 1, mnisl(jii,jni) 318 ii = miisl(jnp,jii,jni) 319 ij = mjisl(jnp,jii,jni) 350 320 gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 351 ELSE 352 ! east-west cyclic boundary conditions 353 IF( ii-jii+3 == 1 ) THEN 354 gcb(jpim1,ij) = gcb(jpim1,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 321 END DO 322 END DO 323 324 IF( lk_mpp ) CALL mpplnks( gcb ) !!bug ? should use an lbclnk ? is it possible??? 325 326 ELSE 327 ! north and south grid-points 328 DO jii = 1, 2 329 DO jnp = 1, mnisl(jii,jni) 330 ii = miisl(jnp,jii,jni) 331 ij = mjisl(jnp,jii,jni) 332 IF( ( nperio == 3 .OR. nperio == 4 ) .AND. ( ij == jpj-1 .AND. jii == 1) ) THEN 333 gcb(jpi-ii+1,ij-1) = gcb(jpi-ii+1,ij-1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 334 ELSE 335 gcb(ii,ij-jii+1) = gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 355 336 ENDIF 356 ENDIF 357 END DO 358 END DO 359 360 # endif 337 END DO 338 END DO 339 340 ! east and west grid-points 341 DO jii = 3, 4 342 DO jnp = 1, mnisl(jii,jni) 343 ii = miisl(jnp,jii,jni) 344 ij = mjisl(jnp,jii,jni) 345 IF( bmask(ii-jii+3,ij) /= 0. ) THEN 346 gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 347 ELSE 348 ! east-west cyclic boundary conditions 349 IF( ii-jii+3 == 1 ) THEN 350 gcb(jpim1,ij) = gcb(jpim1,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij) 351 ENDIF 352 ENDIF 353 END DO 354 END DO 355 ENDIF 361 356 362 357 ! 1.4 Preconditioned right hand side and absolute precision … … 388 383 END DO 389 384 END DO 390 #if defined key_mpp 391 CALL mpp_sum( rnorme ) 392 #endif 385 IF( lk_mpp ) CALL mpp_sum( rnorme ) ! sum over the global domain 386 393 387 IF(lwp) WRITE(numout,*) 'rnorme ', rnorme 394 388 epsr = epsisl * epsisl * rnorme … … 451 445 END DO 452 446 ENDIF 453 #if defined key_mpp 454 CALL lbc_lnk( bsfisl(:,:,jni), 'G', 1. ) 455 #endif 447 IF( lk_mpp ) CALL lbc_lnk( bsfisl(:,:,jni), 'G', 1. ) ! link at G-point 456 448 457 449 -
trunk/NEMO/OPA_SRC/SOL/solmat.F90
r3 r16 18 18 USE obc_oce ! ocean open boundary conditions 19 19 USE lib_mpp ! distributed memory computing 20 USE dynspg_rl 21 USE dynspg_fsc 20 22 21 23 IMPLICIT NONE … … 38 40 !! 39 41 !! ** Method : The matrix depends on the type of free surface: 40 !! * default option: rigid lid and bsf42 !! * lk_dynspg_rl=T: rigid lid formulation 41 43 !! The matrix is built for the barotropic stream function system. 42 44 !! a diagonal preconditioning matrix is also defined. 43 !! * 'key_dynspg_fsc' defined: free surface45 !! * lk_dynspg_fsc=T: free surface formulation 44 46 !! The matrix is built for the divergence of the transport system 45 47 !! a diagonal preconditioning matrix is also defined. … … 67 69 INTEGER :: ii, ij, iiend, ijend ! temporary integers 68 70 REAL(wp) :: zcoefs, zcoefw, zcoefe, zcoefn ! temporary scalars 69 REAL(wp) :: z2dt 70 #if defined key_dynspg_fsc 71 REAL(wp) :: zcoef 72 #endif 71 REAL(wp) :: z2dt, zcoef 73 72 !!---------------------------------------------------------------------- 74 73 … … 83 82 84 83 ! initialize to zero 84 zcoef = 0.e0 85 85 gcp(:,:,1) = 0.e0 86 86 gcp(:,:,2) = 0.e0 … … 94 94 95 95 #if defined key_dynspg_fsc && ! defined key_obc 96 !!cr IF( lk_dynspg_fsc .AND. .NOT.lk_obc ) THEN 96 97 97 98 ! defined the coefficients for free surface elliptic system … … 99 100 DO jj = 2, jpjm1 100 101 DO ji = 2, jpim1 101 zcoef = z2dt * z2dt * g * rnu * bmask(ji,jj)102 zcoef = z2dt * z2dt * grav * rnu * bmask(ji,jj) 102 103 zcoefs = -zcoef * hv(ji ,jj-1) * e1v(ji ,jj-1) / e2v(ji ,jj-1) ! south coefficient 103 104 zcoefw = -zcoef * hu(ji-1,jj ) * e2u(ji-1,jj ) / e1u(ji-1,jj ) ! west coefficient … … 109 110 gcp(ji,jj,4) = zcoefn 110 111 gcdmat(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * bmask(ji,jj) & ! diagonal coefficient 111 112 & - zcoefs -zcoefw -zcoefe -zcoefn 112 113 END DO 113 114 END DO 114 115 115 116 # elif defined key_dynspg_fsc && defined key_obc 117 !!cr ELSEIF( lk_dynspg_fsc .AND. lk_obc ) THEN 116 118 117 119 ! defined gcdmat in the case of open boundaries … … 119 121 DO jj = 2, jpjm1 120 122 DO ji = 2, jpim1 121 zcoef = z2dt * z2dt * g * rnu * bmask(ji,jj)123 zcoef = z2dt * z2dt * grav * rnu * bmask(ji,jj) 122 124 ! south coefficient 123 125 IF( ( lpsouthobc ) .AND. ( jj == njs0p1 ) ) THEN … … 159 161 160 162 # else 163 !!cr ELSE 161 164 162 165 ! defined the coefficients for bsf elliptic system … … 173 176 gcp(ji,jj,4) = zcoefn 174 177 gcdmat(ji,jj) = -zcoefs -zcoefw -zcoefe -zcoefn ! diagonal coefficient 175 176 178 END DO 177 179 END DO 178 180 181 !!cr ENDIF 179 182 #endif 180 183 … … 194 197 ! account for the existence of the south symmetric bassin. 195 198 199 !!cr IF( .NOT.lk_dynspg_fsc ) THEN 196 200 #if ! defined key_dynspg_fsc 197 201 IF( nperio == 2 ) THEN … … 203 207 END DO 204 208 ENDIF 209 !!cr ENDIF 205 210 #endif 206 211 … … 225 230 gcp(:,:,3) = gcp(:,:,3) * gcdprc(:,:) 226 231 gcp(:,:,4) = gcp(:,:,4) * gcdprc(:,:) 232 IF( nsolv == 2 ) gccd(:,:) = sor * gcp(:,:,2) 227 233 228 234 ELSE … … 467 473 nnitot = nni 468 474 469 CALL mpp_sum( nnitot,1,numit0ete)475 CALL mpp_sum( nnitot, 1, numit0ete ) 470 476 CALL feti_creadr(malxm,malxmax,nxm,npe*npe,maae,'ae') 471 477 -
trunk/NEMO/OPA_SRC/SOL/solpcg.F90
r3 r16 14 14 USE lib_mpp ! distributed memory computing 15 15 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 16 USE in_out_manager ! I/O manager 16 17 17 18 IMPLICIT NONE … … 32 33 !! 33 34 !! ** Purpose : Solve the ellipic equation for the barotropic stream 34 !! function system ( default option) or the transport divergence35 !! system ( "key_dynspg_fsc") using a diagonal preconditionned35 !! function system (lk_dynspg_rl=T) or the transport divergence 36 !! system (lk_dynspg_fsc=T) using a diagonal preconditionned 36 37 !! conjugate gradient method. 37 38 !! In the former case, the barotropic stream function trend has a … … 93 94 ! !================ 94 95 95 !,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 96 97 IF( jn == 1 ) THEN 98 99 ! 1.0 Initialization of the algorithm 100 ! ----------------------------------- 101 102 #if defined key_dynspg_fsc 103 # if defined key_mpp 104 ! Mpp: export boundary values to neighbouring processors 105 CALL lbc_lnk( gcx, 'S', 1. ) 106 # else 107 ! mono- or macro-tasking: W-point, >0, 2D array, no slab 108 CALL lbc_lnk( gcx, 'T', 1. ) 109 # endif 110 #else 111 # if defined key_mpp 112 ! ... Mpp: export boundary values to neighbouring processors 113 CALL lbc_lnk( gcx, 'G', 1. ) 114 # else 115 ! ... mono- or macro-tasking: F-point, >0, 2D array, no slab 116 CALL lbc_lnk( gcx, 'F', 1. ) 117 # endif 118 #endif 96 IF( jn == 1 ) THEN ! Initialization of the algorithm 119 97 120 !,,,,,,,,,,,,,,,,,,,,,,,,synchro ,,,,,,,,,,,,,,,,,,,,,,,121 98 CALL lbc_lnk( gcx, c_solver_pt, 1. ) ! lateral boundary condition 99 122 100 ! gcr = gcb-a.gcx 123 101 ! gcdes = gsr 124 125 102 DO jj = 2, jpjm1 126 103 DO ji = fs_2, fs_jpim1 ! vector opt. 127 zgcad = bmask(ji,jj)*( & 128 gcb(ji,jj ) - gcx(ji ,jj ) & 129 - gcp(ji,jj,1)*gcx(ji ,jj-1) & 130 - gcp(ji,jj,2)*gcx(ji-1,jj ) & 131 - gcp(ji,jj,3)*gcx(ji+1,jj ) & 132 - gcp(ji,jj,4)*gcx(ji ,jj+1) ) 104 zgcad = bmask(ji,jj) * ( gcb(ji,jj ) - gcx(ji ,jj ) & 105 & - gcp(ji,jj,1) * gcx(ji ,jj-1) & 106 & - gcp(ji,jj,2) * gcx(ji-1,jj ) & 107 & - gcp(ji,jj,3) * gcx(ji+1,jj ) & 108 & - gcp(ji,jj,4) * gcx(ji ,jj+1) ) 133 109 gcr (ji,jj) = zgcad 134 110 gcdes(ji,jj) = zgcad … … 136 112 END DO 137 113 138 !,,,,,,,,,,,,,,,,,,,,,,,,synchro ,,,,,,,,,,,,,,,,,,,,,,,139 140 114 rnorme = SUM( gcr(:,:) * gcdmat(:,:) * gcr(:,:) ) 141 142 #if defined key_mpp 143 ! Mpp: sum over all the global domain 144 CALL mpp_sum( rnorme ) 145 #endif 115 IF( lk_mpp ) CALL mpp_sum( rnorme ) ! sum over the global domain 146 116 rr = rnorme 147 117 148 ENDIF 149 !,,,,,,,,,,,,,,,,,,,,,,,,synchro ,,,,,,,,,,,,,,,,,,,,,,, 118 ENDIF 150 119 120 ! ! Algorithm 151 121 152 ! 1.1 Algorithm 153 ! ------------- 122 CALL lbc_lnk( gcdes, c_solver_pt, 1. ) ! lateral boundary condition 154 123 155 ! boundary condition on gcdes (only cyclic bc are required) 156 #if defined key_dynspg_fsc 157 # if defined key_mpp 158 ! Mpp: export boundary values to neighbouring processors 159 CALL lbc_lnk( gcdes, 'S', 1. ) 160 # else 161 ! mono- or macro-tasking: W-point, >0, 2D array, no slab 162 CALL lbc_lnk( gcdes, 'T', 1. ) 163 # endif 164 #else 165 # if defined key_mpp 166 ! Mpp: export boundary values to neighbouring processors 167 CALL lbc_lnk( gcdes, 'G', 1. ) 168 # else 169 ! mono- or macro-tasking: F-point, >0, 2D array, no slab 170 CALL lbc_lnk( gcdes, 'F', 1. ) 171 # endif 172 #endif 124 ! ... gccd = matrix . gcdes 125 DO jj = 2, jpjm1 126 DO ji = fs_2, fs_jpim1 ! vector opt. 127 gccd(ji,jj) = bmask(ji,jj)*( gcdes(ji,jj) & 128 & +gcp(ji,jj,1)*gcdes(ji,jj-1)+gcp(ji,jj,2)*gcdes(ji-1,jj) & 129 & +gcp(ji,jj,4)*gcdes(ji,jj+1)+gcp(ji,jj,3)*gcdes(ji+1,jj) ) 130 END DO 131 END DO 132 133 ! alph = (gcr,gcr)/(gcdes,gccd) 134 radd = SUM( gcdes(:,:) * gcdmat(:,:) * gccd(:,:) ) 135 IF( lk_mpp ) CALL mpp_sum( radd ) ! sum over the global domain 136 alph = rr / radd 137 138 ! gcx = gcx + alph * gcdes 139 ! gcr = gcr - alph * gccd 140 DO jj = 2, jpjm1 141 DO ji = fs_2, fs_jpim1 ! vector opt. 142 gcx(ji,jj) = bmask(ji,jj) * ( gcx(ji,jj) + alph * gcdes(ji,jj) ) 143 gcr(ji,jj) = bmask(ji,jj) * ( gcr(ji,jj) - alph * gccd (ji,jj) ) 144 END DO 145 END DO 173 146 174 !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,, 147 ! rnorme = (gcr,gcr) 148 rnorme = SUM( gcr(:,:) * gcdmat(:,:) * gcr(:,:) ) 149 IF( lk_mpp ) CALL mpp_sum( rnorme ) ! sum over the global domain 175 150 176 ! ... gccd = matrix . gcdes177 DO jj = 2, jpjm1178 DO ji = fs_2, fs_jpim1 ! vector opt.179 gccd(ji,jj) = bmask(ji,jj)*( &180 gcdes(ji,jj) &181 +gcp(ji,jj,1)*gcdes(ji,jj-1)+gcp(ji,jj,2)*gcdes(ji-1,jj) &182 +gcp(ji,jj,4)*gcdes(ji,jj+1)+gcp(ji,jj,3)*gcdes(ji+1,jj) &183 184 END DO185 END DO151 ! test of convergence 152 IF( rnorme < epsr .OR. jn == nmax ) THEN 153 res = SQRT( rnorme ) 154 niter = jn 155 ncut = 999 156 ENDIF 157 158 ! beta = (rk+1,rk+1)/(rk,rk) 159 beta = rnorme / rr 160 rr = rnorme 186 161 187 !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,, 162 ! indicator of non-convergence or explosion 163 IF( jn == nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2 164 IF( ncut == 999 ) GOTO 999 165 166 ! gcdes = gcr + beta * gcdes 167 DO jj = 2, jpjm1 168 DO ji = fs_2, fs_jpim1 ! vector opt. 169 gcdes(ji,jj) = bmask(ji,jj)*( gcr(ji,jj) + beta * gcdes(ji,jj) ) 170 END DO 171 END DO 188 172 189 ! alph = (gcr,gcr)/(gcdes,gccd) 190 191 radd = SUM( gcdes(:,:) * gcdmat(:,:) * gccd(:,:) ) 192 193 #if defined key_mpp 194 ! Mpp: sum over all the global domain 195 CALL mpp_sum( radd ) 196 #endif 197 alph = rr / radd 198 199 !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,, 200 201 ! gcx = gcx + alph * gcdes 202 ! gcr = gcr - alph * gccd 203 DO jj = 2, jpjm1 204 DO ji = fs_2, fs_jpim1 ! vector opt. 205 gcx(ji,jj) = bmask(ji,jj) * ( gcx(ji,jj) + alph * gcdes(ji,jj) ) 206 gcr(ji,jj) = bmask(ji,jj) * ( gcr(ji,jj) - alph * gccd (ji,jj) ) 207 END DO 208 END DO 209 210 !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,, 211 212 ! rnorme = (gcr,gcr) 213 214 rnorme = SUM( gcr(:,:) * gcdmat(:,:) * gcr(:,:) ) 215 216 #if defined key_mpp 217 ! Mpp: sum over all the global domain 218 CALL mpp_sum( rnorme ) 219 #endif 220 221 ! test of convergence 222 IF ( rnorme < epsr .OR. jn == nmax ) THEN 223 res = SQRT( rnorme ) 224 niter = jn 225 ncut = 999 226 ENDIF 227 228 ! beta = (rk+1,rk+1)/(rk,rk) 229 beta = rnorme / rr 230 rr = rnorme 231 232 !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,, 233 234 ! indicator of non-convergence or explosion 235 IF( jn == nmax .OR. sqrt(epsr)/eps > 1.e+20 ) kindic = -2 236 IF( ncut == 999 ) GOTO 999 237 238 ! gcdes = gcr + beta * gcdes 239 DO jj = 2, jpjm1 240 DO ji = fs_2, fs_jpim1 ! vector opt. 241 gcdes(ji,jj) = bmask(ji,jj)*( gcr(ji,jj) + beta * gcdes(ji,jj) ) 242 END DO 243 END DO 244 245 ! !================ 246 END DO ! End Loop 247 ! !================ 173 ! !================ 174 END DO ! End Loop 175 ! !================ 248 176 249 999 CONTINUE177 999 CONTINUE 250 178 251 179 252 ! 2.Output in gcx with lateral b.c. applied253 ! ------------------------------------------180 ! Output in gcx with lateral b.c. applied 181 ! --------------------------------------- 254 182 255 ! boundary conditions !!bug ??? 256 #if defined key_mpp 257 ! Mpp: export boundary values to neighbouring processors 258 # if defined key_dynspg_fsc 259 CALL lbc_lnk( gcx, 'S', 1. ) 260 # else 261 CALL lbc_lnk( gcx, 'G', 1. ) 262 # endif 263 #else 264 IF ( nperio /= 0 ) THEN 265 # if defined key_dynspg_fsc 266 ! mono- or macro-tasking: W-point, >0, 2D array, no slab 267 CALL lbc_lnk( gcx, 'T', 1. ) 268 # else 269 ! mono- or macro-tasking: F-point, >0, 2D array, no slab 270 CALL lbc_lnk( gcx, 'F', 1. ) 271 # endif 272 ENDIF 273 #endif 183 CALL lbc_lnk( gcx, c_solver_pt, 1. ) 274 184 275 185 END SUBROUTINE sol_pcg -
trunk/NEMO/OPA_SRC/SOL/solsor.F90
r3 r16 22 22 !! * Routine accessibility 23 23 PUBLIC sol_sor ! ??? 24 24 25 !!---------------------------------------------------------------------- 25 26 !! OPA 9.0 , LODYC-IPSL (2003) … … 28 29 CONTAINS 29 30 30 SUBROUTINE sol_sor( k t, kindic )31 SUBROUTINE sol_sor( kindic ) 31 32 !!---------------------------------------------------------------------- 32 33 !! *** ROUTINE sol_sor *** 33 34 !! 34 35 !! ** Purpose : Solve the ellipic equation for the barotropic stream 35 !! function system ( default option) or the transport divergence36 !! system ( key_dynspg_fsc =T) using a successive-over-relaxation36 !! function system (lk_dynspg_rl=T) or the transport divergence 37 !! system (lk_dynspg_fsc=T) using a successive-over-relaxation 37 38 !! method. 38 39 !! In the former case, the barotropic stream function trend has a … … 59 60 !!---------------------------------------------------------------------- 60 61 !! * Arguments 61 INTEGER, INTENT( in ) :: kt ! ocean time-step62 62 INTEGER, INTENT( inout ) :: kindic ! solver indicator, < 0 if the conver- 63 63 ! ! gence is not reached: the model is … … 67 67 !! * Local declarations 68 68 INTEGER :: ji, jj, jn ! dummy loop indices 69 REAL(wp) :: zgwgt ! temporary scalar70 69 !!---------------------------------------------------------------------- 71 70 72 73 ! Iterative loop 74 ! ============== 75 76 IF( kt == nit000 ) gccd(:,:) = sor * gcp(:,:,2) 71 ! ! ============== 72 DO jn = 1, nmax ! Iterative loop 73 ! ! ============== 77 74 78 79 DO jn = 1, nmax 80 81 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 75 CALL lbc_lnk( gcx, c_solver_pt, 1. ) ! applied the lateral boubary conditions 82 76 83 ! boundary conditions (at each sor iteration) only cyclic b. c. are required 84 #if defined key_dynspg_fsc 85 # if defined key_mpp 86 ! Mpp: export boundary values to neighbouring processors 87 CALL lbc_lnk( gcx, 'S', 1. ) ! S=T with special staff ??? 88 # else 89 CALL lbc_lnk( gcx, 'T', 1. ) 90 # endif 91 #else 92 # if defined key_mpp 93 ! Mpp: export boundary values to neighbouring processors 94 CALL lbc_lnk( gcx, 'G', 1. ) ! G= F with special staff ??? 95 # else 96 CALL lbc_lnk( gcx, 'F', 1. ) 97 # endif 98 #endif 99 100 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 101 102 ! 1. Residus 103 ! ---------- 104 77 ! Residus 78 ! ------- 105 79 DO jj = 2, jpjm1 106 80 DO ji = 2, jpim1 107 gcr(ji,jj) = gcb(ji,jj ) - gcx(ji ,jj ) &108 - gcp(ji,jj,1)*gcx(ji ,jj-1) &109 - gcp(ji,jj,2)*gcx(ji-1,jj ) &110 - gcp(ji,jj,3)*gcx(ji+1,jj ) &111 - gcp(ji,jj,4)*gcx(ji ,jj+1)81 gcr(ji,jj) = gcb(ji,jj ) - gcx(ji ,jj ) & 82 - gcp(ji,jj,1) * gcx(ji ,jj-1) & 83 - gcp(ji,jj,2) * gcx(ji-1,jj ) & 84 - gcp(ji,jj,3) * gcx(ji+1,jj ) & 85 - gcp(ji,jj,4) * gcx(ji ,jj+1) 112 86 END DO 113 87 END DO 88 CALL lbc_lnk( gcr, c_solver_pt, 1. ) ! applied the lateral boubary conditions 114 89 115 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 116 117 ! 1.1 Boundary conditions (at each sor iteration) only cyclic b. c. are required 118 #if defined key_dynspg_fsc 119 # if defined key_mpp 120 ! Mpp: export boundary values to neighbouring processors 121 CALL lbc_lnk( gcr, 'S', 1. ) 122 # else 123 ! mono- or macro-tasking: W-point, >0, 2D array, no slab 124 CALL lbc_lnk( gcr, 'T', 1. ) 125 # endif 126 #else 127 # if defined key_mpp 128 ! Mpp: export boundary values to neighbouring processors 129 CALL lbc_lnk( gcr, 'G', 1. ) 130 # else 131 ! mono- or macro-tasking: W-point, >0, 2D array, no slab 132 CALL lbc_lnk( gcr, 'F', 1. ) 133 # endif 134 #endif 135 136 ! 1.2 Successive over relaxation 137 90 ! Successive over relaxation 138 91 DO jj = 2, jpj 139 92 DO ji = 1, jpi 140 gcr(ji,jj) = gcr(ji,jj) - sor *gcp(ji,jj,1)*gcr(ji,jj-1)93 gcr(ji,jj) = gcr(ji,jj) - sor * gcp(ji,jj,1) * gcr(ji,jj-1) 141 94 END DO 142 95 DO ji = 2, jpi 143 gcr(ji,jj) = gcr(ji,jj) - sor *gcp(ji,jj,2)*gcr(ji-1,jj)96 gcr(ji,jj) = gcr(ji,jj) - sor * gcp(ji,jj,2) * gcr(ji-1,jj) 144 97 END DO 145 98 END DO 146 99 147 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,148 149 100 ! gcx guess 150 151 101 DO jj = 2, jpjm1 152 102 DO ji = 1, jpi 153 gcx(ji,jj) = ( gcx(ji,jj)+sor*gcr(ji,jj))*bmask(ji,jj)103 gcx(ji,jj) = ( gcx(ji,jj) + sor * gcr(ji,jj) ) * bmask(ji,jj) 154 104 END DO 155 105 END DO 156 157 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 158 159 ! boundary conditions (at each sor iteration) only cyclic b. c. are required 160 #if defined key_dynspg_fsc 161 # if defined key_mpp 162 ! Mpp: export boundary values to neighbouring processors 163 CALL lbc_lnk( gcx, 'S', 1. ) 164 # else 165 ! mono- or macro-tasking: W-point, >0, 2D array, no slab 166 CALL lbc_lnk( gcx, 'T', 1. ) 167 # endif 168 #else 169 # if defined key_mpp 170 ! Mpp: export boundary values to neighbouring processors 171 CALL lbc_lnk( gcx, 'G', 1. ) 172 # else 173 ! mono- or macro-tasking: W-point, >0, 2D array, no slab 174 CALL lbc_lnk( gcx, 'F', 1. ) 175 # endif 176 #endif 177 178 ! maximal residu (old exit test on the maximum value of residus) 179 ! 180 ! imax = isamax( jpi*jpj, gcr, 1 ) 181 182 ! avoid an out of bound in no bounds compilation 183 184 ! iimax1 = mod( imax, jpi ) 185 ! ijmax1 = int( float(imax) / float(jpi)) + 1 186 ! resmax = abs( gcr(iimax1,ijmax1) ) 106 CALL lbc_lnk( gcx, c_solver_pt, 1. ) 187 107 188 108 ! relative precision 189 190 rnorme = 0. 191 DO jj = 1, jpj 192 DO ji = 1, jpi 193 zgwgt = gcdmat(ji,jj) * gcr(ji,jj) 194 rnorme= rnorme + gcr(ji,jj)*zgwgt 195 END DO 196 END DO 197 198 #if defined key_mpp 199 ! mpp sum over all the global domain 200 CALL mpp_sum( rnorme ) 201 #endif 109 rnorme = SUM( gcr(:,:) * gcdmat(:,:) * gcr(:,:) ) 110 IF( lk_mpp ) CALL mpp_sum( rnorme ) ! sum over the global domain 202 111 203 112 ! test of convergence … … 216 125 !**** 217 126 218 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,219 220 127 ! indicator of non-convergence or explosion 221 222 128 IF( jn == nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2 223 129 IF( ncut == 999 ) GOTO 999 224 130 225 226 ! END of iterative loop 227 ! ===================== 228 229 END DO 230 131 ! ! ===================== 132 END DO ! END of iterative loop 133 ! ! ===================== 231 134 232 135 999 CONTINUE 233 136 234 137 235 ! 2.Output in gcx236 ! ------------- ----138 ! Output in gcx 139 ! ------------- 237 140 238 ! boundary conditions (est-ce necessaire? je ne crois pas!!!!) 239 240 #if defined key_dynspg_fsc 241 # if defined key_mpp 242 ! Mpp: export boundary values to neighbouring processors 243 CALL lbc_lnk( gcx, 'S', 1. ) 244 # else 245 IF( nperio /= 0 ) THEN 246 CALL lbc_lnk( gcx, 'T', 1. ) 247 ENDIF 248 # endif 249 #else 250 # if defined key_mpp 251 ! Mpp: export boundary values to neighbouring processors 252 CALL lbc_lnk( gcx, 'G', 1. ) 253 # else 254 IF( nperio /= 0 ) THEN 255 CALL lbc_lnk( gcx, 'F', 1. ) 256 ENDIF 257 # endif 258 #endif 141 CALL lbc_lnk( gcx, c_solver_pt, 1. ) ! boundary conditions (est-ce necessaire? je ne crois pas!!!!) 259 142 260 143 END SUBROUTINE sol_sor -
trunk/NEMO/OPA_SRC/SOL/solver.F90
r3 r16 18 18 USE in_out_manager ! I/O manager 19 19 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 USE lib_mpp 21 USE dynspg_rl 22 USE dynspg_fsc 20 23 21 24 IMPLICIT NONE … … 34 37 !! * default option: barotropic stream function system 35 38 !! and islands initialization (if l_isl=T) 36 !! * key_dynspg_fsc = T : transport divergence system. No specific39 !! * lk_dynspg_fsc = T : transport divergence system. No specific 37 40 !! treatment of islands. 38 41 !! 39 42 !! ** Method : 40 43 !! - Compute the local depth of the water column at u- and v-point 41 !! ( key_dynspg_fsc = T) or its inverse (key_dynspg_rl = T).44 !! (lk_dynspg_fsc = T) or its inverse (lk_dynspg_rl = T). 42 45 !! The local depth of the water column is computed by summing 43 46 !! the vertical scale factors. For its inverse, the thickness of … … 56 59 !! 57 60 !! ** Action : - hur, hvr : masked inverse of the local depth at 58 !! u- and v-point. ( key_dynspg_rl = T)61 !! u- and v-point. (lk_dynspg_rl = T) 59 62 !! - hu, hv : masked local depth at u- and v- points 60 !! (key_dynspg_fsc = T) 63 !! (lk_dynspg_fsc = T) 64 !! - c_solver_pt : nature of the gridpoint at which the 65 !! solver is applied 61 66 !! References : 62 67 !! Jensen, 1986: adv. phys. oceanogr. num. mod.,ed. o brien,87-110. … … 115 120 ENDIF 116 121 117 #if defined key_dynspg_fsc 122 IF( lk_dynspg_fsc ) THEN 118 123 IF(lwp) WRITE(numout,*) 119 124 IF(lwp) WRITE(numout,*) ' *** free surface formulation' … … 123 128 nstop = nstop + 1 124 129 ENDIF 125 #endif 126 #if defined key_dynspg_rl 130 ELSEIF( lk_dynspg_rl ) THEN 127 131 IF(lwp) WRITE(numout,*) 128 132 IF(lwp) WRITE(numout,*) ' *** Rigid lid formulation' 129 #endif 130 #if defined key_dynspg_fsc && defined key_dynspg_rl 133 ELSE 134 IF(lwp) WRITE(numout,cform_err) 135 IF(lwp) WRITE(numout,*) ' Chose at least one surface pressure gradient calculation: free surface or rigid-lid' 136 nstop = nstop + 1 137 ENDIF 138 IF( lk_dynspg_fsc .AND. lk_dynspg_rl ) THEN 131 139 IF(lwp) WRITE(numout,cform_err) 132 140 IF(lwp) WRITE(numout,*) ' Chose between free surface or rigid-lid, not both' 133 141 nstop = nstop + 1 134 #endif 142 ENDIF 135 143 136 144 SELECT CASE ( nsolv ) … … 144 152 CASE ( 3 ) ! FETI solver 145 153 IF(lwp) WRITE(numout,*) ' use the FETI solver' 146 #if ! defined key_mpp 147 IF(lwp) WRITE(numout,*) ' The FETI algorithm is used only with the key_mpp option' 148 nstop = nstop + 1 149 #else 150 IF( jpnij == 1 ) THEN 151 IF(lwp) WRITE(numout,*) ' The FETI algorithm needs more than one processor' 154 IF( .NOT.lk_mpp ) THEN 155 IF(lwp) WRITE(numout,*) ' The FETI algorithm is used only with the key_mpp_... option' 152 156 nstop = nstop + 1 153 ENDIF 154 #endif 157 ELSE 158 IF( jpnij == 1 ) THEN 159 IF(lwp) WRITE(numout,*) ' The FETI algorithm needs more than one processor' 160 nstop = nstop + 1 161 ENDIF 162 ENDIF 155 163 156 164 CASE DEFAULT … … 161 169 END SELECT 162 170 171 ! Grid-point at which the solver is applied 172 ! ----------------------------------------- 173 174 IF( lk_dynspg_rl ) THEN ! rigid-lid 175 IF( lk_mpp ) THEN 176 c_solver_pt = 'G' ! G= F with special staff ??? which one? 177 ELSE 178 c_solver_pt = 'F' 179 ENDIF 180 ELSE ! free surface T-point 181 IF( lk_mpp ) THEN 182 c_solver_pt = 'S' ! S=T with special staff ??? which one? 183 ELSE 184 c_solver_pt = 'T' 185 ENDIF 186 ENDIF 187 163 188 164 189 ! Construction of the elliptic system matrix -
trunk/NEMO/OPA_SRC/TRD/trddyn.F90
r3 r16 34 34 35 35 !! * Shared module vaiables 36 LOGICAL, PUBLIC, PARAMETER :: lk_trddyn = .TRUE. !momentum trend flag36 LOGICAL, PUBLIC, PARAMETER :: lk_trddyn = .TRUE. !: momentum trend flag 37 37 38 38 !! * Substitutions … … 231 231 DO ji = 1, jpi 232 232 zhke(10) = zhke(10) & 233 &+ ub(ji,jj,1) * tautrd(ji,jj,1) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) &234 &+ vb(ji,jj,1) * tautrd(ji,jj,2) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1)233 & + ub(ji,jj,1) * tautrd(ji,jj,1) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) & 234 & + vb(ji,jj,1) * tautrd(ji,jj,2) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 235 235 END DO 236 236 END DO … … 240 240 DO jj = 1, jpj 241 241 DO ji = 1, jpi 242 zpeke = zpeke + zkepe(ji,jj,jk) * g * fsdept(ji,jj,jk) &243 &* e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)244 END DO 245 END DO 246 END DO 247 248 # if defined key_mpp 249 CALL mpp_sum( zpeke )250 CALL mpp_sum( zumo , 11 )251 CALL mpp_sum( zvmo , 11 )252 CALL mpp_sum( zhke , 10 )253 # endif 242 zpeke = zpeke + zkepe(ji,jj,jk) * grav * fsdept(ji,jj,jk) & 243 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 244 END DO 245 END DO 246 END DO 247 248 IF( lk_mpp ) THEN 249 CALL mpp_sum( zpeke ) 250 CALL mpp_sum( zumo , 11 ) 251 CALL mpp_sum( zvmo , 11 ) 252 CALL mpp_sum( zhke , 10 ) 253 ENDIF 254 254 255 255 … … 423 423 END DO 424 424 END DO 425 # if defined key_mpp 426 CALL mpp_sum( tvols ) 427 CALL mpp_sum( tvolu ) 428 CALL mpp_sum( tvolv ) 429 # endif 425 IF( lk_mpp ) CALL mpp_sum( tvols ) ! sums over the global domain 426 IF( lk_mpp ) CALL mpp_sum( tvolu ) 427 IF( lk_mpp ) CALL mpp_sum( tvolv ) 430 428 431 429 IF(lwp) THEN … … 446 444 !! Default option : NO mementum trend diagnostics 447 445 !!---------------------------------------------------------------------- 448 LOGICAL, PUBLIC, PARAMETER :: lk_trddyn = .FALSE. ! momentum trend flag446 LOGICAL, PUBLIC, PARAMETER :: lk_trddyn = .FALSE. !: momentum trend flag 449 447 CONTAINS 450 448 SUBROUTINE trd_dyn( kt ) ! Empty routine 451 WRITE(*,*) kt449 WRITE(*,*) 'trd_dyn: You should not have seen this print! error?', kt 452 450 END SUBROUTINE trd_dyn 453 451 SUBROUTINE trd_dyn_init ! Empty routine -
trunk/NEMO/OPA_SRC/TRD/trdmld.F90
r3 r16 37 37 38 38 !! * Shared module variables 39 LOGICAL, PUBLIC, PARAMETER :: lk_trdmld = .TRUE. !momentum trend flag39 LOGICAL, PUBLIC, PARAMETER :: lk_trdmld = .TRUE. !: momentum trend flag 40 40 41 41 !! * Module variables … … 609 609 !! Default option : Empty module 610 610 !!---------------------------------------------------------------------- 611 LOGICAL, PUBLIC, PARAMETER :: lk_trdmld = .FALSE. ! momentum trend flag611 LOGICAL, PUBLIC, PARAMETER :: lk_trdmld = .FALSE. !: momentum trend flag 612 612 CONTAINS 613 613 SUBROUTINE trd_mld( kt ) ! Empty routine 614 WRITE(*,*) kt614 WRITE(*,*) 'trd_mld: You should not have seen this print! error?', kt 615 615 END SUBROUTINE trd_mld 616 616 #endif -
trunk/NEMO/OPA_SRC/TRD/trdtra.F90
r3 r16 33 33 34 34 !! * Shared module variables 35 LOGICAL, PUBLIC, PARAMETER :: lk_trdtra = .TRUE. !momentum trend flag35 LOGICAL, PUBLIC, PARAMETER :: lk_trdtra = .TRUE. !: momentum trend flag 36 36 37 37 !! * Substitutions … … 95 95 END DO 96 96 END DO 97 #if defined key_mpp 98 CALL mpp_sum( tvolt ) 99 #endif 97 IF( lk_mpp ) CALL mpp_sum( tvolt ) ! sum over the global domain 98 100 99 IF(lwp) THEN 101 100 WRITE(numout,*) … … 208 207 END DO 209 208 210 #if defined key_mpp 211 CALL mpp_sum( ztmo, 10 )212 CALL mpp_sum( zsmo, 10 )213 CALL mpp_sum( zt2 , 10 )214 CALL mpp_sum( zs2 , 10 )215 #endif 209 IF( lk_mpp ) THEN 210 CALL mpp_sum( ztmo, 10 ) ! sums over the global domain 211 CALL mpp_sum( zsmo, 10 ) 212 CALL mpp_sum( zt2 , 10 ) 213 CALL mpp_sum( zs2 , 10 ) 214 ENDIF 216 215 217 216 ! 4. Print … … 358 357 END DO 359 358 END DO 360 #if defined key_mpp 361 CALL mpp_sum( tvolt ) 362 #endif 363 IF(lwp) THEN 364 WRITE(numout,*) ' total ocean volume at T-point tvolt = ',tvolt 365 ENDIF 359 IF( lk_mpp ) CALL mpp_sum( tvolt ) ! sum over the global domain 360 361 IF(lwp) WRITE(numout,*) ' total ocean volume at T-point tvolt = ',tvolt 366 362 367 363 END SUBROUTINE trd_tra_init … … 371 367 !! Default case : Empty module 372 368 !!---------------------------------------------------------------------- 373 LOGICAL, PUBLIC, PARAMETER :: lk_trdtra = .FALSE. ! momentum trend flag369 LOGICAL, PUBLIC, PARAMETER :: lk_trdtra = .FALSE. !: momentum trend flag 374 370 CONTAINS 375 371 SUBROUTINE trd_tra( kt ) ! Empty routine 376 WRITE(*,*) kt372 WRITE(*,*) 'trd_tra: You should not have seen this print! error?', kt 377 373 END SUBROUTINE trd_tra 378 374 SUBROUTINE trd_tra_init ! Empty routine -
trunk/NEMO/OPA_SRC/TRD/trdtra_oce.F90
r3 r16 12 12 PUBLIC 13 13 14 INTEGER :: & !! !namdia : diagnostics on dynamics and/or tracer trends14 INTEGER :: & !!: namdia : diagnostics on dynamics and/or tracer trends 15 15 ntrd = 10 , & !: time step frequency dynamics and tracers trends 16 16 nctls = 0 !: control surface type for trends vertical integration … … 25 25 !! Trends diagnostics parameters 26 26 !!--------------------------------------------------------------------- 27 INTEGER, PARAMETER :: & 27 INTEGER, PARAMETER :: & !: 28 28 # if defined key_traldf_eiv 29 29 jptrdh = 4, & !: number of 3D horiz trends arrays … … 38 38 !! Trends diagnostics variables 39 39 !!--------------------------------------------------------------------- 40 REAL(wp) :: & 41 tvolt ! volume of the whole ocean computed at t-points42 REAL(wp), DIMENSION(jpi,jpj,jpk,7) :: & 40 REAL(wp) :: & !: 41 tvolt !: volume of the whole ocean computed at t-points 42 REAL(wp), DIMENSION(jpi,jpj,jpk,7) :: & !: 43 43 ttrd !: trends of the temperature tracer equations 44 44 ! ! ttrd(,,,1) : horizontal advection … … 49 49 ! ! ttrd(,,,6) : damping OR vertical EIV 50 50 ! ! ttrd(,,,7) : penetrative solar radiation (T only) 51 REAL(wp), DIMENSION(jpi,jpj,jpk,6) :: & 51 REAL(wp), DIMENSION(jpi,jpj,jpk,6) :: & !: 52 52 strd !: trends of the salinity tracer equations 53 53 ! ! same as ttrd() 54 REAL(wp), DIMENSION(jpi,jpj,jpk,jptrdh) :: & 54 REAL(wp), DIMENSION(jpi,jpj,jpk,jptrdh) :: & !: 55 55 ttrdh, strdh !: ttrdh(,,,1) : zonal advection 56 56 ! ! ttrdh(,,,2) : meridional advection 57 57 ! ! ttrdh(,,,3) : zonal EIV 58 58 ! ! ttrdh(,,,4) : meridional EIV 59 REAL(wp), DIMENSION(jpi,jpj,2) :: & 59 REAL(wp), DIMENSION(jpi,jpj,2) :: & !: 60 60 flxtrd, & !: tracer forcing trends 61 61 bbltrd !: tracer bottom boundary layer trends -
trunk/NEMO/OPA_SRC/ZDF/zdf_oce.F90
r3 r16 15 15 16 16 !! * Share Module variables 17 LOGICAL, PARAMETER, PUBLIC :: & 17 LOGICAL, PARAMETER, PUBLIC :: & !: 18 18 #if defined key_zdfcst || defined key_esopa 19 19 lk_zdfcst = .TRUE. !: constant vertical mixing flag … … 21 21 lk_zdfcst = .FALSE. !: constant vertical mixing flag 22 22 #endif 23 LOGICAL, PUBLIC :: & 23 LOGICAL, PUBLIC :: & !: 24 24 ln_zdfevd = .TRUE. , & !: convection: enhanced vertical diffusion flag 25 25 ln_zdfnpc = .FALSE. !: convection: non-penetrative convection flag 26 26 27 LOGICAL, PUBLIC :: & 27 LOGICAL, PUBLIC :: & !: 28 28 l_trazdf_exp = .FALSE. , & !: ??? 29 29 l_trazdf_imp = .FALSE. , & !: … … 32 32 l_dynzdf_imp_tsk = .FALSE. !: 33 33 34 INTEGER, PUBLIC :: & !! !namzdf: vertical diffusion34 INTEGER, PUBLIC :: & !!: namzdf: vertical diffusion 35 35 n_zdfexp = 3 , & !: number of sub-time step (explicit time stepping) 36 36 nevdm = 1 !: =0/1 flag to apply enhanced avm or not 37 37 38 REAL(wp), PUBLIC :: & !! !namzdf vertical diffusion38 REAL(wp), PUBLIC :: & !!: namzdf vertical diffusion 39 39 avm0 = 1.e-4_wp, & !: vertical eddy viscosity (m2/s) 40 40 avt0 = 1.e-5_wp, & !: vertical eddy diffusivity (m2/s) 41 41 avevd = 1._wp !: vertical eddy coeff. for enhanced vert. diff. (m2/s) 42 42 43 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & 43 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 44 44 avmu, & !: vertical viscosity coeff. at uw-, vw-points 45 45 avmv, & !: vertical viscosity coeff. at uw-, vw-points 46 46 avt !: vertical diffusivity coeff. at w-point 47 47 48 REAL(wp), PUBLIC, DIMENSION(jpk) :: & 48 REAL(wp), PUBLIC, DIMENSION(jpk) :: & !: 49 49 avmb, avtb !: background profile of avm and avt 50 50 -
trunk/NEMO/OPA_SRC/ZDF/zdfddm.F90
r3 r16 25 25 26 26 !! * Shared module variables 27 LOGICAL, PUBLIC :: lk_zdfddm = .TRUE. !: double diffusive mixing flag28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & 27 LOGICAL, PUBLIC, PARAMETER :: lk_zdfddm = .TRUE. !: double diffusive mixing flag 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 29 29 avs , & !: salinity vertical diffusivity coeff. at w-point 30 30 rrau !: heat/salt buoyancy flux ratio … … 242 242 !! Default option : Dummy module No double diffusion 243 243 !!---------------------------------------------------------------------- 244 LOGICAL, PUBLIC :: lk_zdfddm = .FALSE. !: double diffusion flag244 LOGICAL, PUBLIC, PARAMETER :: lk_zdfddm = .FALSE. !: double diffusion flag 245 245 CONTAINS 246 246 SUBROUTINE zdf_ddm( kt ) ! Dummy routine 247 WRITE(*,*) kt ! avoid compil warning247 WRITE(*,*) 'zdf_ddm: You should not have seen this print! error?', kt 248 248 END SUBROUTINE zdf_ddm 249 249 #endif -
trunk/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r3 r16 21 21 22 22 !! * Shared module variables 23 INTEGER, PUBLIC, DIMENSION(jpi,jpj) :: & 23 INTEGER, PUBLIC, DIMENSION(jpi,jpj) :: & !: 24 24 nmln !: number of level in the mixed layer 25 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & 25 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 26 26 hmld , & !: mixing layer depth (turbocline) (m) 27 27 hmlp , & !: mixed layer depth (rho=rho0+zdcrit) (m) -
trunk/NEMO/OPA_SRC/ZDF/zdfric.F90
r3 r16 28 28 29 29 !! * Shared module variables 30 LOGICAL, PUBLIC, PARAMETER :: lk_zdfric = .TRUE. !: Richardson vertical mixing flag30 LOGICAL, PUBLIC, PARAMETER :: lk_zdfric = .TRUE. !: Richardson vertical mixing flag 31 31 32 32 !! * Module variables … … 256 256 CONTAINS 257 257 SUBROUTINE zdf_ric( kt ) ! Dummy routine 258 WRITE(*,*) kt258 WRITE(*,*) 'zdf_ric: You should not have seen this print! error?', kt 259 259 END SUBROUTINE zdf_ric 260 260 #endif -
trunk/NEMO/OPA_SRC/ZDF/zdftke.F90
r3 r16 28 28 29 29 !! * Share Module variables 30 LOGICAL, PUBLIC, PARAMETER :: lk_zdftke = .TRUE. !: TKE vertical mixing flag31 LOGICAL, PUBLIC :: & !! !** tke namelist (namtke) **30 LOGICAL, PUBLIC, PARAMETER :: lk_zdftke = .TRUE. !: TKE vertical mixing flag 31 LOGICAL, PUBLIC :: & !!: ** tke namelist (namtke) ** 32 32 ln_rstke = .FALSE. !: =T restart with tke from a run without tke with 33 33 ! ! a none zero initial value for en 34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & 34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 35 35 en !: now turbulent kinetic energy 36 36 … … 92 92 !! d(en)/dt = eboost eav (d(u)/dz)**2 ! shear production 93 93 !! + d( efave eav d(en)/dz )/dz ! diffusion of tke 94 !! + g /rau0 pdl eav d(rau)/dz! stratif. destruc.94 !! + grav/rau0 pdl eav d(rau)/dz ! stratif. destruc. 95 95 !! - ediss / emxl en**(2/3) ! dissipation 96 96 !! with the boundary conditions: … … 791 791 !! Dummy module : NO TKE scheme 792 792 !!---------------------------------------------------------------------- 793 LOGICAL, PUBLIC, PARAMETER :: lk_zdftke = .FALSE. ! TKE flag793 LOGICAL, PUBLIC, PARAMETER :: lk_zdftke = .FALSE. !: TKE flag 794 794 CONTAINS 795 795 SUBROUTINE zdf_tke( kt ) ! Empty routine 796 WRITE(*,*) kt ! no compilation warning796 WRITE(*,*) 'zdf_tke: You should not have seen this print! error?', kt 797 797 END SUBROUTINE zdf_tke 798 798 #endif
Note: See TracChangeset
for help on using the changeset viewer.