Changeset 2236
- Timestamp:
- 2010-10-12T20:49:32+02:00 (14 years ago)
- Location:
- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC
- Files:
-
- 3 deleted
- 144 edited
- 8 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdy_oce.F90
- Property svn:executable deleted
r1170 r2236 6 6 !! History : 1.0 ! 2001-05 (J. Chanut, A. Sellar) Original code 7 7 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 8 !! 3.3 ! 2010-09 (D. Storkey) add ice boundary conditions 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_bdy … … 54 55 !! Unstructured open boundary data variables 55 56 !!---------------------------------------------------------------------- 56 INTEGER, DIMENSION(jpbgrd) :: nblen 57 INTEGER, DIMENSION(jpbgrd) :: nblenrim 58 INTEGER, DIMENSION(jpbgrd) :: nblendta 57 INTEGER, DIMENSION(jpbgrd) :: nblen = 0 !: Size of bdy data on a proc for each grid type 58 INTEGER, DIMENSION(jpbgrd) :: nblenrim = 0 !: Size of bdy data on a proc for first rim ind 59 INTEGER, DIMENSION(jpbgrd) :: nblendta = 0 !: Size of bdy data in file 59 60 60 61 INTEGER, DIMENSION(jpbdim,jpbgrd) :: nbi, nbj !: i and j indices of bdy dta … … 73 74 REAL(wp), DIMENSION(jpbdim) :: sshtide !: Tidal boundary array : SSH 74 75 REAL(wp), DIMENSION(jpbdim) :: utide, vtide !: Tidal boundary array : U and V 76 #if defined key_lim2 77 REAL(wp), DIMENSION(jpbdim) :: & 78 frld_bdy, hicif_bdy, & !: Now clim of ice leads fraction, ice 79 hsnif_bdy !: thickness and snow thickness 80 #endif 75 81 76 82 #else … … 84 90 !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 85 91 !! $Id$ 86 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)92 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 87 93 !!====================================================================== 88 94 END MODULE bdy_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdy_par.F90
- Property svn:executable deleted
r1146 r2236 6 6 !! History : 1.0 ! 2005-01 (J. Chanut, A. Sellar) Original code 7 7 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 8 !! 3.3 ! 2010-09 (D. Storkey and E. O'Dea) update for Shelf configurations 8 9 !!---------------------------------------------------------------------- 9 #if defined key_bdy10 #if defined key_bdy 10 11 !!---------------------------------------------------------------------- 11 12 !! 'key_bdy' : Unstructured Open Boundary Condition … … 15 16 PUBLIC 16 17 17 18 LOGICAL, PUBLIC, PARAMETER :: lk_bdy = .TRUE. !: Unstructured Ocean Boundary Condition flag 19 INTEGER, PUBLIC, PARAMETER :: jpbdta = 5000 !: Max length of bdy field in file 20 INTEGER, PUBLIC, PARAMETER :: jpbdim = 5000 !: Max length of bdy field on a processor 21 INTEGER, PUBLIC, PARAMETER :: jpbtime = 1000 !: Max number of time dumps per file 22 INTEGER, PUBLIC, PARAMETER :: jpbgrd = 3 !: Number of horizontal grid types used (T, u, v, f) 18 LOGICAL, PUBLIC, PARAMETER :: lk_bdy = .TRUE. !: Unstructured Ocean Boundary Condition flag 19 INTEGER, PUBLIC, PARAMETER :: jpbdta = 20000 !: Max length of bdy field in file 20 INTEGER, PUBLIC, PARAMETER :: jpbdim = 20000 !: Max length of bdy field on a processor 21 INTEGER, PUBLIC, PARAMETER :: jpbtime = 1000 !: Max number of time dumps per file 22 INTEGER, PUBLIC, PARAMETER :: jpbgrd = 6 !: Number of horizontal grid types used (T, u, v, f) 23 23 #else 24 24 !!---------------------------------------------------------------------- … … 29 29 30 30 !!---------------------------------------------------------------------- 31 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)31 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 32 32 !! $Id$ 33 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)33 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 34 34 !!====================================================================== 35 35 END MODULE bdy_par -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdydta.F90
- Property svn:executable deleted
r1715 r2236 8 8 !! - ! 2007-07 (D. Storkey) add bdy_dta_bt 9 9 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 10 !! 3.3 ! 2010-09 (E.O'Dea) modifications for Shelf configurations 11 !! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions 10 12 !!---------------------------------------------------------------------- 11 13 #if defined key_bdy … … 14 16 !!---------------------------------------------------------------------- 15 17 !! bdy_dta : read u, v, t, s data along open boundaries 16 !! bdy_dta_bt : read depth-mean velocities and elevation along open 17 !! boundaries 18 !! bdy_dta_bt : read depth-mean velocities and elevation along open boundaries 18 19 !!---------------------------------------------------------------------- 19 20 USE oce ! ocean dynamics and tracers … … 25 26 USE ioipsl 26 27 USE in_out_manager ! I/O logical units 28 #if defined key_lim2 29 USE ice_2 30 #endif 27 31 28 32 IMPLICIT NONE … … 32 36 PUBLIC bdy_dta_bt 33 37 34 INTEGER :: numbdyt, numbdyu, numbdyv !: logical units for T-, U-, & V-points data file, resp. 35 INTEGER :: ntimes_bdy !: exact number of time dumps in data files 36 INTEGER :: nbdy_b, nbdy_a !: record of bdy data file for before and after model time step 37 INTEGER :: numbdyt_bt, numbdyu_bt, numbdyv_bt !: logical unit for T-, U- & V-points data file, resp. 38 INTEGER :: ntimes_bdy_bt !: exact number of time dumps in data files 39 INTEGER :: nbdy_b_bt, nbdy_a_bt !: record of bdy data file for before and after model time step 40 41 INTEGER, DIMENSION (jpbtime) :: istep, istep_bt !: time array in seconds in each data file 42 43 REAL(wp) :: zoffset !: time offset between time origin in file & start time of model run 44 45 REAL(wp), DIMENSION(jpbdim,jpk,2) :: tbdydta, sbdydta !: time interpolated values of T and S bdy data 46 REAL(wp), DIMENSION(jpbdim,jpk,2) :: ubdydta, vbdydta !: time interpolated values of U and V bdy data 47 REAL(wp), DIMENSION(jpbdim,2) :: ubtbdydta, vbtbdydta !: Arrays used for time interpolation of bdy data 48 REAL(wp), DIMENSION(jpbdim,2) :: sshbdydta !: bdy data of ssh 38 INTEGER :: numbdyt, numbdyu, numbdyv ! logical units for T-, U-, & V-points data file, resp. 39 INTEGER :: ntimes_bdy ! exact number of time dumps in data files 40 INTEGER :: nbdy_b, nbdy_a ! record of bdy data file for before and after time step 41 INTEGER :: numbdyt_bt, numbdyu_bt, numbdyv_bt ! logical unit for T-, U- & V-points data file, resp. 42 INTEGER :: ntimes_bdy_bt ! exact number of time dumps in data files 43 INTEGER :: nbdy_b_bt, nbdy_a_bt ! record of bdy data file for before and after time step 44 45 INTEGER, DIMENSION (jpbtime) :: istep, istep_bt ! time array in seconds in each data file 46 47 REAL(wp) :: zoffset ! time offset between time origin in file & start time of model run 48 49 REAL(wp), DIMENSION(jpbdim,jpk,2) :: tbdydta, sbdydta ! time interpolated values of T and S bdy data 50 REAL(wp), DIMENSION(jpbdim,jpk,2) :: ubdydta, vbdydta ! time interpolated values of U and V bdy data 51 REAL(wp), DIMENSION(jpbdim,2) :: ubtbdydta, vbtbdydta ! Arrays used for time interpolation of bdy data 52 REAL(wp), DIMENSION(jpbdim,2) :: sshbdydta ! bdy data of ssh 53 54 #if defined key_lim2 55 REAL(wp), DIMENSION(jpbdim,2) :: frld_bdydta ! } 56 REAL(wp), DIMENSION(jpbdim,2) :: hicif_bdydta ! } Arrays used for time interp. of ice bdy data 57 REAL(wp), DIMENSION(jpbdim,2) :: hsnif_bdydta ! } 58 #endif 49 59 50 60 !!---------------------------------------------------------------------- 51 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)61 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 52 62 !! $Id$ 53 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)63 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 54 64 !!---------------------------------------------------------------------- 55 56 65 CONTAINS 57 66 … … 67 76 !! the file. If so read it in. Time interpolate. 68 77 !!---------------------------------------------------------------------- 69 INTEGER, INTENT( in ) :: kt 78 INTEGER, INTENT( in ) :: kt ! ocean time-step index (for timesplitting option, otherwise zero) 70 79 !! 71 80 CHARACTER(LEN=80), DIMENSION(3) :: clfile ! names of input files … … 79 88 INTEGER :: itimer, totime 80 89 INTEGER :: ii, ij ! array addresses 81 INTEGER :: ipi, ipj, ipk, inum ! temporaryintegers (NetCDF read)90 INTEGER :: ipi, ipj, ipk, inum ! local integers (NetCDF read) 82 91 INTEGER :: iyear0, imonth0, iday0 83 92 INTEGER :: ihours0, iminutes0, isec0 … … 91 100 !!--------------------------------------------------------------------------- 92 101 93 IF( ln_bdy_dyn_frs .OR. ln_bdy_tra_frs ) THEN ! If these are both false then this routine 94 ! does nothing. 102 103 IF( ln_bdy_dyn_frs .OR. ln_bdy_tra_frs & 104 & .OR. ln_bdy_ice_frs ) THEN ! If these are both false then this routine does nothing 95 105 96 106 ! -------------------- ! … … 102 112 ! Some time variables for monthly climatological forcing: 103 113 ! ******************************************************* 104 !!gm here use directely daymod variables 114 115 !!gm here use directely daymod calendar variables 105 116 106 117 iman = INT( raamo ) ! Number of months in a year … … 121 132 ! !-------------------! 122 133 istep(:) = 0 123 nbdy_b 124 nbdy_a 134 nbdy_b = 0 135 nbdy_a = 0 125 136 126 137 ! Get time information from bdy data file … … 151 162 igrd_start = 1 152 163 igrd_end = 3 153 IF(.NOT. ln_bdy_tra_frs .AND. .NOT. ln_bdy_ice_frs) THEN 154 ! No T-grid file. 164 IF(.NOT. ln_bdy_tra_frs .AND. .NOT. ln_bdy_ice_frs) THEN ! No T-grid file. 155 165 igrd_start = 2 156 ELSEIF ( .NOT. ln_bdy_dyn_frs ) THEN 157 ! No U-grid or V-grid file. 166 ELSEIF ( .NOT. ln_bdy_dyn_frs ) THEN ! No U-grid or V-grid file. 158 167 igrd_end = 1 159 168 ENDIF … … 165 174 166 175 SELECT CASE( igrd ) 167 CASE (1) 168 numbdyt = inum 169 CASE (2) 170 numbdyu = inum 171 CASE (3) 172 numbdyv = inum 176 CASE (1) ; numbdyt = inum 177 CASE (2) ; numbdyu = inum 178 CASE (3) ; numbdyv = inum 173 179 END SELECT 174 180 … … 196 202 IF(lwp) WRITE(numout,*) 'offset: ',zoffset 197 203 IF(lwp) WRITE(numout,*) 'totime: ',totime 198 IF(lwp) WRITE(numout,*) 'zstepr: ',zstepr 204 IF(lwp) WRITE(numout,*) 'zstepr: ',zstepr(1:ntimes_bdy) 199 205 200 206 ! Check that there are not too many times in the file. … … 205 211 206 212 ! Check that time array increases: 207 208 213 it = 1 209 DO WHILE( zstepr(it+1) > zstepr(it) .AND. it /= ntimes_bdy - 1 ) 210 it = it + 1214 DO WHILE( zstepr(it+1) > zstepr(it) .AND. it /= ntimes_bdy - 1 ) 215 it = it + 1 211 216 END DO 212 213 IF( it .NE.ntimes_bdy-1 .AND. ntimes_bdy > 1 ) THEN217 ! 218 IF( it /= ntimes_bdy-1 .AND. ntimes_bdy > 1 ) THEN 214 219 WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 215 220 CALL ctl_stop( 'Time array in unstructured boundary data files', & … … 227 232 END IF 228 233 ! 229 IF ( igrd == 1 ) THEN 230 ntimes_bdyt = ntimes_bdy 231 zoffsett = zoffset 232 istept(:) = INT( zstepr(:) + zoffset ) 233 ELSEIF(igrd == 2 ) THEN 234 ntimes_bdyu = ntimes_bdy 235 zoffsetu = zoffset 236 istepu(:) = INT( zstepr(:) + zoffset ) 237 ELSEIF(igrd == 3 ) THEN 238 ntimes_bdyv = ntimes_bdy 239 zoffsetv = zoffset 240 istepv(:) = INT( zstepr(:) + zoffset ) 241 ENDIF 234 SELECT CASE( igrd ) 235 CASE (1) 236 ntimes_bdyt = ntimes_bdy 237 zoffsett = zoffset 238 istept(:) = INT( zstepr(:) + zoffset ) 239 numbdyt = inum 240 CASE (2) 241 ntimes_bdyu = ntimes_bdy 242 zoffsetu = zoffset 243 istepu(:) = INT( zstepr(:) + zoffset ) 244 numbdyu = inum 245 CASE (3) 246 ntimes_bdyv = ntimes_bdy 247 zoffsetv = zoffset 248 istepv(:) = INT( zstepr(:) + zoffset ) 249 numbdyv = inum 250 END SELECT 242 251 ! 243 252 END DO ! end loop over T, U & V grid … … 259 268 ENDIF 260 269 261 IF( igrd_start == 1 ) THEN 262 istep(:) = istept(:) 263 ELSE 264 istep(:) = istepu(:) 270 IF( igrd_start == 1 ) THEN ; istep(:) = istept(:) 271 ELSE ; istep(:) = istepu(:) 265 272 ENDIF 266 273 … … 287 294 it = 1 288 295 DO WHILE( istep(it+1) <= 0 .AND. it <= ntimes_bdy - 1 ) 289 it = it + 1296 it = it + 1 290 297 END DO 291 298 nbdy_b = it 292 299 ! 293 WRITE(numout,*) 'Time offset is ',zoffset294 WRITE(numout,*) 'First record to read is ',nbdy_b300 IF(lwp) WRITE(numout,*) 'Time offset is ',zoffset 301 IF(lwp) WRITE(numout,*) 'First record to read is ',nbdy_b 295 302 296 303 ENDIF ! endif (nbdy_dta == 1) … … 300 307 ! ***************************************************************** 301 308 302 IF( nbdy_dta == 0 ) THEN ! boundary data arrays are filled with initial conditions309 IF( nbdy_dta == 0 ) THEN ! boundary data arrays are filled with initial conditions 303 310 ! 304 311 IF (ln_bdy_tra_frs) THEN 305 igrd = 1 ! T-points data306 DO ib = 1, nblen(igrd)307 ii = nbi(ib,igrd)308 ij = nbj(ib,igrd)309 DO ik = 1, jpkm1310 tbdy(ib,ik) = tn(ii, ij,ik)311 sbdy(ib,ik) = sn(ii, ij,ik)312 ENDDO313 END DO312 igrd = 1 ! T-points data 313 DO ib = 1, nblen(igrd) 314 ii = nbi(ib,igrd) 315 ij = nbj(ib,igrd) 316 DO ik = 1, jpkm1 317 tbdy(ib,ik) = tn(ii,ij,ik) 318 sbdy(ib,ik) = sn(ii,ij,ik) 319 END DO 320 END DO 314 321 ENDIF 315 322 316 323 IF(ln_bdy_dyn_frs) THEN 317 igrd = 2 ! U-points data318 DO ib = 1, nblen(igrd)319 ii = nbi(ib,igrd)320 ij = nbj(ib,igrd)321 DO ik = 1, jpkm1322 ubdy(ib,ik) = un(ii, ij, ik)323 ENDDO324 END DO325 326 igrd = 3 ! V-points data327 DO ib = 1, nblen(igrd)328 ii = nbi(ib,igrd)329 ij = nbj(ib,igrd)330 DO ik = 1, jpkm1331 vbdy(ib,ik) = vn(ii, ij, ik)332 ENDDO333 END DO324 igrd = 2 ! U-points data 325 DO ib = 1, nblen(igrd) 326 ii = nbi(ib,igrd) 327 ij = nbj(ib,igrd) 328 DO ik = 1, jpkm1 329 ubdy(ib,ik) = un(ii, ij, ik) 330 END DO 331 END DO 332 ! 333 igrd = 3 ! V-points data 334 DO ib = 1, nblen(igrd) 335 ii = nbi(ib,igrd) 336 ij = nbj(ib,igrd) 337 DO ik = 1, jpkm1 338 vbdy(ib,ik) = vn(ii, ij, ik) 339 END DO 340 END DO 334 341 ENDIF 335 342 ! 343 #if defined key_lim2 344 IF( ln_bdy_ice_frs ) THEN 345 igrd = 1 ! T-points data 346 DO ib = 1, nblen(igrd) 347 frld_bdy (ib) = frld(nbi(ib,igrd), nbj(ib,igrd)) 348 hicif_bdy(ib) = hicif(nbi(ib,igrd), nbj(ib,igrd)) 349 hsnif_bdy(ib) = hsnif(nbi(ib,igrd), nbj(ib,igrd)) 350 END DO 351 ENDIF 352 #endif 336 353 ELSEIF( nbdy_dta == 1 ) THEN ! Set first record in the climatological case: 337 354 ! … … 352 369 353 370 IF(ln_bdy_tra_frs) THEN 371 ! 354 372 igrd = 1 ! Temperature 355 373 IF( nblendta(igrd) <= 0 ) THEN … … 357 375 nblendta(igrd) = iom_file(numbdyt)%dimsz(1,idvar) 358 376 ENDIF 359 WRITE(numout,*) 'Dim size for votemper is ', nblendta(igrd)377 IF(lwp) WRITE(numout,*) 'Dim size for votemper is ', nblendta(igrd) 360 378 ipi = nblendta(igrd) 361 379 CALL iom_get ( numbdyt, jpdom_unknown, 'votemper', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 362 380 ! 363 381 DO ib = 1, nblen(igrd) 364 382 DO ik = 1, jpkm1 … … 372 390 nblendta(igrd) = iom_file(numbdyt)%dimsz(1,idvar) 373 391 ENDIF 374 WRITE(numout,*) 'Dim size for vosaline is ', nblendta(igrd)392 IF(lwp) WRITE(numout,*) 'Dim size for vosaline is ', nblendta(igrd) 375 393 ipi = nblendta(igrd) 376 394 CALL iom_get ( numbdyt, jpdom_unknown, 'vosaline', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 377 395 ! 378 396 DO ib = 1, nblen(igrd) 379 397 DO ik = 1, jpkm1 … … 383 401 ENDIF ! ln_bdy_tra_frs 384 402 385 IF( ln_bdy_dyn_frs) THEN386 403 IF( ln_bdy_dyn_frs ) THEN 404 ! 387 405 igrd = 2 ! u-velocity 388 406 IF ( nblendta(igrd) .le. 0 ) THEN … … 390 408 nblendta(igrd) = iom_file(numbdyu)%dimsz(1,idvar) 391 409 ENDIF 392 WRITE(numout,*) 'Dim size for vozocrtx is ', nblendta(igrd)410 IF(lwp) WRITE(numout,*) 'Dim size for vozocrtx is ', nblendta(igrd) 393 411 ipi = nblendta(igrd) 394 412 CALL iom_get ( numbdyu, jpdom_unknown,'vozocrtx',zdta(1:ipi,1:ipj,1:ipk),nbdy_a ) … … 404 422 nblendta(igrd) = iom_file(numbdyv)%dimsz(1,idvar) 405 423 ENDIF 406 WRITE(numout,*) 'Dim size for vomecrty is ', nblendta(igrd)424 IF(lwp) WRITE(numout,*) 'Dim size for vomecrty is ', nblendta(igrd) 407 425 ipi = nblendta(igrd) 408 426 CALL iom_get ( numbdyv, jpdom_unknown,'vomecrty',zdta(1:ipi,1:ipj,1:ipk),nbdy_a ) … … 414 432 ENDIF ! ln_bdy_dyn_frs 415 433 416 417 IF ((.NOT.ln_bdy_clim) .AND. (istep(1) > 0)) THEN 418 ! First data time is after start of run 419 ! Put first value in both time levels 434 #if defined key_lim2 435 IF( ln_bdy_ice_frs ) THEN 436 ! 437 igrd=1 ! leads fraction 438 IF(lwp) WRITE(numout,*) 'Dim size for ildsconc is ',nblendta(igrd) 439 ipi=nblendta(igrd) 440 CALL iom_get ( numbdyt, jpdom_unknown,'ildsconc',zdta(1:ipi,:,1),nbdy_a ) 441 DO ib=1, nblen(igrd) 442 frld_bdydta(ib,2) = zdta(nbmap(ib,igrd),1,1) 443 END DO 444 ! 445 igrd=1 ! ice thickness 446 IF(lwp) WRITE(numout,*) 'Dim size for iicethic is ',nblendta(igrd) 447 ipi=nblendta(igrd) 448 CALL iom_get ( numbdyt, jpdom_unknown,'iicethic',zdta(1:ipi,:,1),nbdy_a ) 449 DO ib=1, nblen(igrd) 450 hicif_bdydta(ib,2) = zdta(nbmap(ib,igrd),1,1) 451 END DO 452 ! 453 igrd=1 ! snow thickness 454 IF(lwp) WRITE(numout,*) 'Dim size for isnowthi is ',nblendta(igrd) 455 ipi=nblendta(igrd) 456 CALL iom_get ( numbdyt, jpdom_unknown,'isnowthi',zdta(1:ipi,:,1),nbdy_a ) 457 DO ib=1, nblen(igrd) 458 hsnif_bdydta(ib,2) = zdta(nbmap(ib,igrd),1,1) 459 END DO 460 ENDIF ! just if ln_bdy_ice_frs is set 461 #endif 462 463 IF( .NOT.ln_bdy_clim .AND. istep(1) > 0 ) THEN ! First data time is after start of run 464 nbdy_b = nbdy_a ! Put first value in both time levels 465 IF( ln_bdy_tra_frs ) THEN 466 tbdydta(:,:,1) = tbdydta(:,:,2) 467 sbdydta(:,:,1) = sbdydta(:,:,2) 468 ENDIF 469 IF( ln_bdy_dyn_frs ) THEN 470 ubdydta(:,:,1) = ubdydta(:,:,2) 471 vbdydta(:,:,1) = vbdydta(:,:,2) 472 ENDIF 473 #if defined key_lim2 474 IF( ln_bdy_ice_frs ) THEN 475 frld_bdydta (:,1) = frld_bdydta(:,2) 476 hicif_bdydta(:,1) = hicif_bdydta(:,2) 477 hsnif_bdydta(:,1) = hsnif_bdydta(:,2) 478 ENDIF 479 #endif 480 END IF 481 ! 482 END IF ! nbdy_dta == 0/1 483 484 ! In the case of constant boundary forcing fill bdy arrays once for all 485 IF( ln_bdy_clim .AND. ntimes_bdy == 1 ) THEN 486 IF( ln_bdy_tra_frs ) THEN 487 tbdy (:,:) = tbdydta (:,:,2) 488 sbdy (:,:) = sbdydta (:,:,2) 489 ENDIF 490 IF( ln_bdy_dyn_frs) THEN 491 ubdy (:,:) = ubdydta (:,:,2) 492 vbdy (:,:) = vbdydta (:,:,2) 493 ENDIF 494 #if defined key_lim2 495 IF( ln_bdy_ice_frs ) THEN 496 frld_bdy (:) = frld_bdydta (:,2) 497 hicif_bdy(:) = hicif_bdydta(:,2) 498 hsnif_bdy(:) = hsnif_bdydta(:,2) 499 ENDIF 500 #endif 501 502 IF( ln_bdy_tra_frs .OR. ln_bdy_ice_frs) CALL iom_close( numbdyt ) 503 IF( ln_bdy_dyn_frs ) CALL iom_close( numbdyu ) 504 IF( ln_bdy_dyn_frs ) CALL iom_close( numbdyv ) 505 END IF 506 ! 507 ENDIF ! End if nit000 508 509 510 ! !---------------------! 511 IF( nbdy_dta == 1 .AND. ntimes_bdy > 1 ) THEN ! at each time step ! 512 ! !---------------------! 513 ! Read one more record if necessary 514 !********************************** 515 516 IF( ln_bdy_clim .AND. imois /= nbdy_b ) THEN ! remember that nbdy_b=0 for kt=nit000 517 nbdy_b = imois 518 nbdy_a = imois + 1 519 nbdy_b = MOD( nbdy_b, iman ) ; IF( nbdy_b == 0 ) nbdy_b = iman 520 nbdy_a = MOD( nbdy_a, iman ) ; IF( nbdy_a == 0 ) nbdy_a = iman 521 lect=.true. 522 ELSEIF( .NOT.ln_bdy_clim .AND. itimer >= istep(nbdy_a) ) THEN 523 524 IF( nbdy_a < ntimes_bdy ) THEN 525 nbdy_b = nbdy_a 526 nbdy_a = nbdy_a + 1 527 lect =.true. 528 ELSE 529 ! We have reached the end of the file 530 ! put the last data time into both time levels 420 531 nbdy_b = nbdy_a 421 532 IF(ln_bdy_tra_frs) THEN 422 tbdydta(:,:,1) =tbdydta(:,:,2)423 sbdydta(:,:,1) =sbdydta(:,:,2)533 tbdydta(:,:,1) = tbdydta(:,:,2) 534 sbdydta(:,:,1) = sbdydta(:,:,2) 424 535 ENDIF 425 536 IF(ln_bdy_dyn_frs) THEN 426 ubdydta(:,:,1) = ubdydta(:,:,2) 427 vbdydta(:,:,1) = vbdydta(:,:,2) 428 ENDIF 429 END IF 430 431 END IF ! nbdy_dta == 0/1 432 433 ! In the case of constant boundary forcing fill bdy arrays once for all 434 IF ((ln_bdy_clim).AND.(ntimes_bdy==1)) THEN 435 IF(ln_bdy_tra_frs) THEN 436 tbdy (:,:) = tbdydta (:,:,2) 437 sbdy (:,:) = sbdydta (:,:,2) 438 ENDIF 439 IF(ln_bdy_dyn_frs) THEN 440 ubdy (:,:) = ubdydta (:,:,2) 441 vbdy (:,:) = vbdydta (:,:,2) 442 ENDIF 443 444 IF(ln_bdy_tra_frs .or. ln_bdy_ice_frs) CALL iom_close( numbdyt ) 445 IF(ln_bdy_dyn_frs) CALL iom_close( numbdyu ) 446 IF(ln_bdy_dyn_frs) CALL iom_close( numbdyv ) 447 END IF 448 449 ENDIF ! End if nit000 450 451 452 ! !---------------------! 453 ! ! at each time step ! 454 ! !---------------------! 455 456 IF( nbdy_dta == 1 .AND. ntimes_bdy > 1 ) THEN 457 ! 458 ! Read one more record if necessary 459 !********************************** 460 461 IF( ln_bdy_clim .AND. imois /= nbdy_b ) THEN ! remember that nbdy_b=0 for kt=nit000 462 nbdy_b = imois 463 nbdy_a = imois + 1 464 nbdy_b = MOD( nbdy_b, iman ) ; IF( nbdy_b == 0 ) nbdy_b = iman 465 nbdy_a = MOD( nbdy_a, iman ) ; IF( nbdy_a == 0 ) nbdy_a = iman 466 lect=.true. 467 ELSEIF( .NOT.ln_bdy_clim .AND. itimer >= istep(nbdy_a) ) THEN 468 469 IF ( nbdy_a < ntimes_bdy ) THEN 470 nbdy_b = nbdy_a 471 nbdy_a = nbdy_a + 1 472 lect =.true. 473 ELSE 474 ! We have reached the end of the file 475 ! put the last data time into both time levels 476 nbdy_b = nbdy_a 477 IF(ln_bdy_tra_frs) THEN 478 tbdydta(:,:,1) = tbdydta(:,:,2) 479 sbdydta(:,:,1) = sbdydta(:,:,2) 480 ENDIF 481 IF(ln_bdy_dyn_frs) THEN 482 ubdydta(:,:,1) = ubdydta(:,:,2) 483 vbdydta(:,:,1) = vbdydta(:,:,2) 484 ENDIF 537 ubdydta(:,:,1) = ubdydta(:,:,2) 538 vbdydta(:,:,1) = vbdydta(:,:,2) 539 ENDIF 540 #if defined key_lim2 541 IF(ln_bdy_ice_frs) THEN 542 frld_bdydta (:,1) = frld_bdydta (:,2) 543 hicif_bdydta(:,1) = hicif_bdydta(:,2) 544 hsnif_bdydta(:,1) = hsnif_bdydta(:,2) 545 ENDIF 546 #endif 485 547 END IF ! nbdy_a < ntimes_bdy 486 548 ! 487 549 END IF 488 550 489 IF( lect ) THEN 490 ! Swap arrays 491 IF(ln_bdy_tra_frs) THEN 551 IF( lect ) THEN ! Swap arrays 552 IF( ln_bdy_tra_frs ) THEN 492 553 tbdydta(:,:,1) = tbdydta(:,:,2) 493 554 sbdydta(:,:,1) = sbdydta(:,:,2) 494 555 ENDIF 495 IF( ln_bdy_dyn_frs) THEN556 IF( ln_bdy_dyn_frs ) THEN 496 557 ubdydta(:,:,1) = ubdydta(:,:,2) 497 558 vbdydta(:,:,1) = vbdydta(:,:,2) 498 559 ENDIF 499 560 #if defined key_lim2 561 IF( ln_bdy_ice_frs ) THEN 562 frld_bdydta (:,1) = frld_bdydta (:,2) 563 hicif_bdydta(:,1) = hicif_bdydta(:,2) 564 hsnif_bdydta(:,1) = hsnif_bdydta(:,2) 565 ENDIF 566 #endif 500 567 ! read another set 501 568 ipj = 1 502 569 ipk = jpk 503 570 504 IF( ln_bdy_tra_frs) THEN571 IF( ln_bdy_tra_frs ) THEN 505 572 ! 506 573 igrd = 1 ! temperature … … 543 610 END DO 544 611 ENDIF ! ln_bdy_dyn_frs 545 612 ! 613 #if defined key_lim2 614 IF(ln_bdy_ice_frs) THEN 615 ! 616 igrd = 1 ! ice concentration 617 ipi=nblendta(igrd) 618 CALL iom_get ( numbdyt, jpdom_unknown,'ildsconc',zdta(1:ipi,:,1),nbdy_a ) 619 DO ib=1, nblen(igrd) 620 frld_bdydta(ib,2) = zdta( nbmap(ib,igrd), 1, 1 ) 621 END DO 622 ! 623 igrd=1 ! ice thickness 624 ipi=nblendta(igrd) 625 CALL iom_get ( numbdyt, jpdom_unknown,'iicethic',zdta(1:ipi,:,1),nbdy_a ) 626 DO ib=1, nblen(igrd) 627 hicif_bdydta(ib,2) = zdta( nbmap(ib,igrd), 1, 1 ) 628 END DO 629 ! 630 igrd=1 ! snow thickness 631 ipi=nblendta(igrd) 632 CALL iom_get ( numbdyt, jpdom_unknown,'isnowthi',zdta(1:ipi,:,1),nbdy_a ) 633 DO ib=1, nblen(igrd) 634 hsnif_bdydta(ib,2) = zdta( nbmap(ib,igrd), 1, 1 ) 635 END DO 636 ENDIF ! ln_bdy_ice_frs 637 #endif 546 638 ! 547 639 IF(lwp) WRITE(numout,*) 'bdy_dta : first record file used nbdy_b ',nbdy_b … … 559 651 ! ******************** 560 652 ! 561 IF( ln_bdy_clim ) THEN ; zxy = REAL( nday , wp ) / REAL( nmonth_len(nbdy_b), wp ) + 0.5 - i15 562 ELSE ; zxy = REAL( istep(nbdy_b) - itimer, wp ) / REAL( istep(nbdy_b) - istep(nbdy_a), wp ) 653 IF( ln_bdy_clim ) THEN ; zxy = REAL( nday ) / REAL( nmonth_len(nbdy_b) ) + 0.5 - i15 654 ELSEIF( istep(nbdy_b) == istep(nbdy_a) ) THEN 655 zxy = 0.0_wp 656 ELSE ; zxy = REAL( istep(nbdy_b) - itimer ) / REAL( istep(nbdy_b) - istep(nbdy_a) ) 563 657 END IF 564 658 … … 589 683 ENDIF 590 684 685 #if defined key_lim2 686 IF(ln_bdy_ice_frs) THEN 687 igrd=1 688 DO ib=1, nblen(igrd) 689 frld_bdy(ib) = zxy * frld_bdydta(ib,2) + (1.-zxy) * frld_bdydta(ib,1) 690 hicif_bdy(ib) = zxy * hicif_bdydta(ib,2) + (1.-zxy) * hicif_bdydta(ib,1) 691 hsnif_bdy(ib) = zxy * hsnif_bdydta(ib,2) + (1.-zxy) * hsnif_bdydta(ib,1) 692 END DO 693 ENDIF ! just if ln_bdy_ice_frs is true 694 #endif 695 591 696 END IF !end if ((nbdy_dta==1).AND.(ntimes_bdy>1)) 592 697 … … 602 707 ! 603 708 ENDIF ! ln_bdy_dyn_frs .OR. ln_bdy_tra_frs 604 709 ! 605 710 END SUBROUTINE bdy_dta 606 711 607 712 608 SUBROUTINE bdy_dta_bt( kt, jit )713 SUBROUTINE bdy_dta_bt( kt, jit, icycl ) 609 714 !!--------------------------------------------------------------------------- 610 715 !! *** SUBROUTINE bdy_dta_bt *** … … 620 725 INTEGER, INTENT( in ) :: kt ! ocean time-step index 621 726 INTEGER, INTENT( in ) :: jit ! barotropic time step index 727 INTEGER, INTENT( in ) :: icycl ! number of cycles need for final file close 622 728 ! ! (for timesplitting option, otherwise zero) 623 729 !! … … 639 745 REAL(wp), DIMENSION(jpbtime) :: zstepr ! REAL time array from data files 640 746 REAL(wp), DIMENSION(jpbdta,1) :: zdta ! temporary array for data fields 641 CHARACTER(LEN=80), DIMENSION( 3) :: clfile747 CHARACTER(LEN=80), DIMENSION(6) :: clfile 642 748 CHARACTER(LEN=70 ) :: clunits ! units attribute of time coordinate 643 749 !!--------------------------------------------------------------------------- … … 688 794 689 795 ! !-------------------! 690 IF( kt == nit000 ) THEN! First call only !796 IF( kt == nit000 .and. jit ==2 ) THEN ! First call only ! 691 797 ! !-------------------! 692 798 istep_bt(:) = 0 … … 712 818 ! necessary time dumps in file are included 713 819 714 clfile( 1) = filbdy_data_bt_T715 clfile( 2) = filbdy_data_bt_U716 clfile( 3) = filbdy_data_bt_V717 718 DO igrd = 1,3820 clfile(4) = filbdy_data_bt_T 821 clfile(5) = filbdy_data_bt_U 822 clfile(6) = filbdy_data_bt_V 823 824 DO igrd = 4,6 719 825 720 826 CALL iom_open( clfile(igrd), inum ) 721 CALL iom_gettime( inum, zstepr, kntime=ntimes_bdy , cdunits=clunits )827 CALL iom_gettime( inum, zstepr, kntime=ntimes_bdy_bt, cdunits=clunits ) 722 828 723 829 SELECT CASE( igrd ) 724 CASE ( 1)725 numbdyt = inum726 CASE ( 2)727 numbdyu = inum728 CASE ( 3)729 numbdyv = inum830 CASE (4) 831 numbdyt_bt = inum 832 CASE (5) 833 numbdyu_bt = inum 834 CASE (6) 835 numbdyv_bt = inum 730 836 END SELECT 731 837 … … 757 863 758 864 ! Check that time array increases (or interp will fail): 759 DO it = 2, ntimes_bdy 865 DO it = 2, ntimes_bdy_bt 760 866 IF ( zstepr(it-1) >= zstepr(it) ) THEN 761 867 CALL ctl_stop('Time array in unstructured boundary data file', & … … 778 884 ! The same applies to the last time level: see setting of lect below. 779 885 780 IF ( ntimes_bdy == 1 ) CALL ctl_stop( &886 IF ( ntimes_bdy_bt == 1 ) CALL ctl_stop( & 781 887 'There is only one time dump in data files', & 782 888 'Set ln_bdy_clim=.true. in namelist for constant bdy forcing.' ) 783 889 784 890 zinterval_s = zstepr(2) - zstepr(1) 785 zinterval_e = zstepr(ntimes_bdy) - zstepr(ntimes_bdy-1) 786 787 IF ( zstepr(1) - zinterval_s / 2.0 > 0 ) THEN 788 IF(lwp) WRITE(numout,*) 'First bdy time relative to nit000:', zstepr(1) 789 IF(lwp) WRITE(numout,*) 'Interval between first two times: ', zinterval_s 790 CALL ctl_stop( 'First data time is after start of run', & 791 'by more than half a meaning period', & 792 'Check file: ' // TRIM(clfile(igrd)) ) 891 zinterval_e = zstepr(ntimes_bdy_bt) - zstepr(ntimes_bdy_bt-1) 892 893 IF( zstepr(1) + zoffset > 0 ) THEN 894 WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 895 CALL ctl_stop( 'First time dump in bdy file is after model initial time', ctmp1 ) 793 896 END IF 794 795 IF ( zstepr(ntimes_bdy) + zinterval_e / 2.0 < totime ) THEN 796 IF(lwp) WRITE(numout,*) 'Last bdy time relative to nit000:', zstepr(ntimes_bdy) 797 IF(lwp) WRITE(numout,*) 'Interval between last two times: ', zinterval_e 798 CALL ctl_stop( 'Last data time is before end of run', & 799 'by more than half a meaning period', & 800 'Check file: ' // TRIM(clfile(igrd)) ) 897 IF( zstepr(ntimes_bdy_bt) + zoffset < totime ) THEN 898 WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 899 CALL ctl_stop( 'Last time dump in bdy file is before model final time', ctmp1 ) 801 900 END IF 802 803 901 END IF ! .NOT. ln_bdy_clim 804 902 805 IF ( igrd .EQ. 1) THEN903 IF ( igrd .EQ. 4) THEN 806 904 ntimes_bdyt = ntimes_bdy_bt 807 905 zoffsett = zoffset 808 906 istept(:) = INT( zstepr(:) + zoffset ) 809 ELSE IF (igrd .EQ. 2) THEN907 ELSE IF (igrd .EQ. 5) THEN 810 908 ntimes_bdyu = ntimes_bdy_bt 811 909 zoffsetu = zoffset 812 910 istepu(:) = INT( zstepr(:) + zoffset ) 813 ELSE IF (igrd .EQ. 3) THEN911 ELSE IF (igrd .EQ. 6) THEN 814 912 ntimes_bdyv = ntimes_bdy_bt 815 913 zoffsetv = zoffset … … 865 963 nbdy_b_bt = it 866 964 867 WRITE(numout,*) 'Time offset is ',zoffset868 WRITE(numout,*) 'First record to read is ',nbdy_b_bt965 IF(lwp) WRITE(numout,*) 'Time offset is ',zoffset 966 IF(lwp) WRITE(numout,*) 'First record to read is ',nbdy_b_bt 869 967 870 968 ENDIF ! endif (nbdy_dta == 1) … … 875 973 IF ( nbdy_dta == 0) THEN 876 974 ! boundary data arrays are filled with initial conditions 877 igrd = 2! U-points data975 igrd = 5 ! U-points data 878 976 DO ib = 1, nblen(igrd) 879 977 ubtbdy(ib) = un(nbi(ib,igrd), nbj(ib,igrd), 1) 880 978 END DO 881 979 882 igrd = 3! V-points data980 igrd = 6 ! V-points data 883 981 DO ib = 1, nblen(igrd) 884 982 vbtbdy(ib) = vn(nbi(ib,igrd), nbj(ib,igrd), 1) 885 983 END DO 886 984 887 igrd = 1! T-points data985 igrd = 4 ! T-points data 888 986 DO ib = 1, nblen(igrd) 889 987 sshbdy(ib) = sshn(nbi(ib,igrd), nbj(ib,igrd)) … … 910 1008 ! Read first record: 911 1009 ipj=1 912 igrd= 11010 igrd=4 913 1011 ipi=nblendta(igrd) 914 1012 915 1013 ! ssh 916 igrd= 11014 igrd=4 917 1015 IF ( nblendta(igrd) .le. 0 ) THEN 918 1016 idvar = iom_varid( numbdyt_bt,'sossheig' ) … … 929 1027 930 1028 ! u-velocity 931 igrd= 21029 igrd=5 932 1030 IF ( nblendta(igrd) .le. 0 ) THEN 933 1031 idvar = iom_varid( numbdyu_bt,'vobtcrtx' ) … … 944 1042 945 1043 ! v-velocity 946 igrd= 31044 igrd=6 947 1045 IF ( nblendta(igrd) .le. 0 ) THEN 948 1046 idvar = iom_varid( numbdyv_bt,'vobtcrty' ) … … 1010 1108 ipj=1 1011 1109 ipk=jpk 1012 igrd= 11110 igrd=4 1013 1111 ipi=nblendta(igrd) 1014 1112 1015 1113 1016 1114 ! ssh 1017 igrd= 11115 igrd=4 1018 1116 ipi=nblendta(igrd) 1019 1117 … … 1025 1123 1026 1124 ! u-velocity 1027 igrd= 21125 igrd=5 1028 1126 ipi=nblendta(igrd) 1029 1127 … … 1035 1133 1036 1134 ! v-velocity 1037 igrd= 31135 igrd=6 1038 1136 ipi=nblendta(igrd) 1039 1137 … … 1064 1162 END IF 1065 1163 1066 igrd= 11164 igrd=4 1067 1165 DO ib=1, nblen(igrd) 1068 1166 sshbdy(ib) = zxy * sshbdydta(ib,2) + & … … 1070 1168 END DO 1071 1169 1072 igrd= 21170 igrd=5 1073 1171 DO ib=1, nblen(igrd) 1074 1172 ubtbdy(ib) = zxy * ubtbdydta(ib,2) + & … … 1076 1174 END DO 1077 1175 1078 igrd= 31176 igrd=6 1079 1177 DO ib=1, nblen(igrd) 1080 1178 vbtbdy(ib) = zxy * vbtbdydta(ib,2) + & … … 1090 1188 1091 1189 ! Closing of the 3 files 1092 IF( kt == nitend ) THEN1190 IF( kt == nitend .and. jit == icycl ) THEN 1093 1191 CALL iom_close( numbdyt_bt ) 1094 1192 CALL iom_close( numbdyu_bt ) … … 1109 1207 WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt 1110 1208 END SUBROUTINE bdy_dta 1111 SUBROUTINE bdy_dta_bt( kt, kit ) ! Empty routine1209 SUBROUTINE bdy_dta_bt( kt, kit, icycle ) ! Empty routine 1112 1210 WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt, kit 1113 1211 END SUBROUTINE bdy_dta_bt -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdydyn.F90
- Property svn:executable deleted
r1740 r2236 8 8 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 9 9 !! 3.2 ! 2008-04 (R. Benshila) consider velocity instead of transport 10 !! 3.3 ! 2010-09 (E.O'Dea) modifications for Shelf configurations 11 !! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions 10 12 !!---------------------------------------------------------------------- 11 13 #if defined key_bdy … … 34 36 35 37 !!---------------------------------------------------------------------- 36 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)38 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 37 39 !! $Id$ 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)40 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 39 41 !!---------------------------------------------------------------------- 40 41 42 CONTAINS 42 43 … … 54 55 INTEGER, INTENT( in ) :: kt ! Main time step counter 55 56 !! 56 INTEGER :: ib, ik, igrd! dummy loop indices57 INTEGER :: ii, ij ! 2D addresses58 REAL(wp) :: zwgt 57 INTEGER :: jb, jk ! dummy loop indices 58 INTEGER :: ii, ij, igrd ! local integers 59 REAL(wp) :: zwgt ! boundary weight 59 60 !!---------------------------------------------------------------------- 60 61 ! 61 IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing.62 62 IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing. 63 ! 63 64 IF( kt == nit000 ) THEN 64 65 IF(lwp) WRITE(numout,*) … … 68 69 ! 69 70 igrd = 2 ! Relaxation of zonal velocity 70 DO ib = 1, nblen(igrd)71 DO ik = 1, jpkm172 ii = nbi(ib,igrd)73 ij = nbj(ib,igrd)74 zwgt = nbw( ib,igrd)75 ua(ii,ij, ik) = ( ua(ii,ij,ik) * ( 1.- zwgt ) + ubdy(ib,ik) * zwgt ) * umask(ii,ij,ik)71 DO jb = 1, nblen(igrd) 72 DO jk = 1, jpkm1 73 ii = nbi(jb,igrd) 74 ij = nbj(jb,igrd) 75 zwgt = nbw(jb,igrd) 76 ua(ii,ij,jk) = ( ua(ii,ij,jk) * ( 1.- zwgt ) + ubdy(jb,jk) * zwgt ) * umask(ii,ij,jk) 76 77 END DO 77 78 END DO 78 79 ! 79 80 igrd = 3 ! Relaxation of meridional velocity 80 DO ib = 1, nblen(igrd)81 DO ik = 1, jpkm182 ii = nbi(ib,igrd)83 ij = nbj(ib,igrd)84 zwgt = nbw( ib,igrd)85 va(ii,ij, ik) = ( va(ii,ij,ik) * ( 1.- zwgt ) + vbdy(ib,ik) * zwgt ) * vmask(ii,ij,ik)81 DO jb = 1, nblen(igrd) 82 DO jk = 1, jpkm1 83 ii = nbi(jb,igrd) 84 ij = nbj(jb,igrd) 85 zwgt = nbw(jb,igrd) 86 va(ii,ij,jk) = ( va(ii,ij,jk) * ( 1.- zwgt ) + vbdy(jb,jk) * zwgt ) * vmask(ii,ij,jk) 86 87 END DO 87 88 END DO 88 ! 89 CALL lbc_lnk( ua, 'U', -1. ) ! Boundary points should be updated 90 CALL lbc_lnk( va, 'V', -1. ) ! 89 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) ! Boundary points should be updated 91 90 ! 92 91 ENDIF ! ln_bdy_dyn_frs 93 92 ! 94 93 END SUBROUTINE bdy_dyn_frs 95 94 96 95 97 #if defined key_dynspg_exp || defined key_dynspg_ts 96 # if defined key_dynspg_exp || defined key_dynspg_ts 97 !!---------------------------------------------------------------------- 98 !! 'key_dynspg_exp' OR explicit sea surface height 99 !! 'key_dynspg_ts ' split-explicit sea surface height 100 !!---------------------------------------------------------------------- 101 98 102 !! Option to use Flather with dynspg_flt not coded yet... 103 99 104 SUBROUTINE bdy_dyn_fla( pssh ) 100 105 !!---------------------------------------------------------------------- … … 119 124 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssh 120 125 121 INTEGER :: ib, igrd ! dummy loop indices126 INTEGER :: jb, igrd ! dummy loop indices 122 127 INTEGER :: ii, ij, iim1, iip1, ijm1, ijp1 ! 2D addresses 123 128 REAL(wp) :: zcorr ! Flather correction … … 132 137 133 138 ! Fill temporary array with ssh data (here spgu): 134 igrd = 1139 igrd = 4 135 140 spgu(:,:) = 0.0 136 DO ib = 1, nblenrim(igrd)137 ii = nbi( ib,igrd)138 ij = nbj( ib,igrd)139 IF( ln_bdy_dyn_fla ) spgu(ii, ij) = sshbdy( ib)140 IF( ln_bdy_tides ) spgu(ii, ij) = spgu(ii, ij) + sshtide( ib)141 DO jb = 1, nblenrim(igrd) 142 ii = nbi(jb,igrd) 143 ij = nbj(jb,igrd) 144 IF( ln_bdy_dyn_fla ) spgu(ii, ij) = sshbdy(jb) 145 IF( ln_bdy_tides ) spgu(ii, ij) = spgu(ii, ij) + sshtide(jb) 141 146 END DO 142 147 ! 143 igrd = 2! Flather bc on u-velocity;148 igrd = 5 ! Flather bc on u-velocity; 144 149 ! ! remember that flagu=-1 if normal velocity direction is outward 145 150 ! ! I think we should rather use after ssh ? 146 DO ib = 1, nblenrim(igrd)147 ii = nbi( ib,igrd)148 ij = nbj( ib,igrd)149 iim1 = ii + MAX( 0, INT( flagu( ib) ) ) ! T pts i-indice inside the boundary150 iip1 = ii - MIN( 0, INT( flagu( ib) ) ) ! T pts i-indice outside the boundary151 DO jb = 1, nblenrim(igrd) 152 ii = nbi(jb,igrd) 153 ij = nbj(jb,igrd) 154 iim1 = ii + MAX( 0, INT( flagu(jb) ) ) ! T pts i-indice inside the boundary 155 iip1 = ii - MIN( 0, INT( flagu(jb) ) ) ! T pts i-indice outside the boundary 151 156 ! 152 zcorr = - flagu( ib) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )153 zforc = ubtbdy( ib) + utide(ib)157 zcorr = - flagu(jb) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 158 zforc = ubtbdy(jb) + utide(jb) 154 159 ua_e(ii,ij) = zforc + zcorr * umask(ii,ij,1) 155 160 END DO 156 161 ! 157 igrd = 3! Flather bc on v-velocity162 igrd = 6 ! Flather bc on v-velocity 158 163 ! ! remember that flagv=-1 if normal velocity direction is outward 159 DO ib = 1, nblenrim(igrd)160 ii = nbi( ib,igrd)161 ij = nbj( ib,igrd)162 ijm1 = ij + MAX( 0, INT( flagv( ib) ) ) ! T pts j-indice inside the boundary163 ijp1 = ij - MIN( 0, INT( flagv( ib) ) ) ! T pts j-indice outside the boundary164 DO jb = 1, nblenrim(igrd) 165 ii = nbi(jb,igrd) 166 ij = nbj(jb,igrd) 167 ijm1 = ij + MAX( 0, INT( flagv(jb) ) ) ! T pts j-indice inside the boundary 168 ijp1 = ij - MIN( 0, INT( flagv(jb) ) ) ! T pts j-indice outside the boundary 164 169 ! 165 zcorr = - flagv( ib) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )166 zforc = vbtbdy( ib) + vtide(ib)170 zcorr = - flagv(jb) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 171 zforc = vbtbdy(jb) + vtide(jb) 167 172 va_e(ii,ij) = zforc + zcorr * vmask(ii,ij,1) 168 173 END DO 174 CALL lbc_lnk( ua_e, 'U', -1. ) ! Boundary points should be updated 175 CALL lbc_lnk( va_e, 'V', -1. ) ! 169 176 ! 170 177 ENDIF ! ln_bdy_dyn_fla .or. ln_bdy_tides -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyini.F90
- Property svn:executable deleted
r1528 r2236 8 8 !! - ! 2007-01 (D. Storkey) Tidal forcing 9 9 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 10 !! 3.3 ! 2010-09 (E.O'Dea) updates for Shelf configurations 11 !! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions 10 12 !!---------------------------------------------------------------------- 11 13 #if defined key_bdy … … 17 19 USE oce ! ocean dynamics and tracers variables 18 20 USE dom_oce ! ocean space and time domain 21 USE obc_par ! ocean open boundary conditions 19 22 USE bdy_oce ! unstructured open boundary conditions 20 23 USE bdytides ! tides at open boundaries initialization (tide_init routine) … … 30 33 31 34 !!---------------------------------------------------------------------- 32 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)35 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 33 36 !! $Id$ 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 35 !!--------------------------------------------------------------------------------- 36 37 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 38 !!---------------------------------------------------------------------- 37 39 CONTAINS 38 40 … … 48 50 !! 49 51 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 50 !!51 52 !!---------------------------------------------------------------------- 52 53 INTEGER :: ii, ij, ik, igrd, ib, ir ! dummy loop indices … … 54 55 INTEGER :: ib_len, ibr_max 55 56 INTEGER :: iw, ie, is, in 56 INTEGER :: inum ! temporarylogical unit57 INTEGER :: id_dummy ! temporaryintegers57 INTEGER :: inum ! local logical unit 58 INTEGER :: id_dummy ! local integers 58 59 INTEGER :: igrd_start, igrd_end ! start and end of loops on igrd 59 60 INTEGER, DIMENSION (2) :: kdimsz … … 63 64 REAL(wp) , DIMENSION(jpidta,jpjdta) :: zmask ! global domain mask 64 65 REAL(wp) , DIMENSION(jpbdta,1) :: zdta ! temporary array 65 CHARACTER(LEN=80),DIMENSION( 3) :: clfile66 CHARACTER(LEN=80),DIMENSION(6) :: clfile 66 67 !! 67 68 NAMELIST/nambdy/filbdy_mask, filbdy_data_T, filbdy_data_U, filbdy_data_V, & 69 & filbdy_data_bt_T, filbdy_data_bt_U, filbdy_data_bt_V, & 68 70 & ln_bdy_tides, ln_bdy_clim, ln_bdy_vol, ln_bdy_mask, & 69 & ln_bdy_dyn_fla, ln_bdy_dyn_frs, ln_bdy_tra_frs, 70 & nbdy_dta , nb_rimwidth, volbdy71 & ln_bdy_dyn_fla, ln_bdy_dyn_frs, ln_bdy_tra_frs,ln_bdy_ice_frs, & 72 & nbdy_dta, nb_rimwidth, volbdy 71 73 !!---------------------------------------------------------------------- 72 74 … … 75 77 IF(lwp) WRITE(numout,*) '~~~~~~~~' 76 78 ! 77 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 78 ' and unstructured open boundary condition are not compatible' ) 79 80 #if defined key_obc 81 CALL ctl_stop( 'Straight open boundaries,', & 82 ' and unstructured open boundaries are not compatible' ) 83 #endif 84 85 ! Read namelist parameters 79 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 80 & ' and unstructured open boundary condition are not compatible' ) 81 82 IF( lk_obc ) CALL ctl_stop( 'Straight open boundaries,', & 83 & ' and unstructured open boundaries are not compatible' ) 84 86 85 ! --------------------------- 87 REWIND( numnam ) 86 REWIND( numnam ) ! Read namelist parameters 88 87 READ ( numnam, nambdy ) 89 88 90 ! control prints89 ! ! control prints 91 90 IF(lwp) WRITE(numout,*) ' nambdy' 92 91 93 ! Check nbdy_dta value92 ! ! check type of data used (nbdy_dta value) 94 93 IF(lwp) WRITE(numout,*) 'nbdy_dta =', nbdy_dta 95 IF(lwp) WRITE(numout,*) ' ' 96 SELECT CASE( nbdy_dta ) 97 CASE( 0 ) 98 IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 99 CASE( 1 ) 100 IF(lwp) WRITE(numout,*) ' boundary data taken from file' 101 CASE DEFAULT 102 CALL ctl_stop( 'nbdy_dta must be 0 or 1' ) 94 IF(lwp) WRITE(numout,*) 95 SELECT CASE( nbdy_dta ) ! 96 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 97 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' boundary data taken from file' 98 CASE DEFAULT ; CALL ctl_stop( 'nbdy_dta must be 0 or 1' ) 103 99 END SELECT 104 100 105 IF(lwp) WRITE(numout,*) ' '101 IF(lwp) WRITE(numout,*) 106 102 IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS nb_rimwidth = ', nb_rimwidth 107 103 108 IF(lwp) WRITE(numout,*) ' ' 109 IF(lwp) WRITE(numout,*) ' volbdy = ', volbdy 110 111 IF (ln_bdy_vol) THEN 112 SELECT CASE ( volbdy ) ! Check volbdy value 113 CASE( 1 ) 114 IF(lwp) WRITE(numout,*) ' The total volume will be constant' 115 CASE( 0 ) 116 IF(lwp) WRITE(numout,*) ' The total volume will vary according' 117 IF(lwp) WRITE(numout,*) ' to the surface E-P flux' 118 CASE DEFAULT 119 CALL ctl_stop( 'volbdy must be 0 or 1' ) 120 END SELECT 104 IF(lwp) WRITE(numout,*) 105 IF(lwp) WRITE(numout,*) ' volbdy = ', volbdy 106 107 IF( ln_bdy_vol ) THEN ! check volume conservation (volbdy value) 108 SELECT CASE ( volbdy ) 109 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' The total volume will be constant' 110 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' The total volume will vary according to the surface E-P flux' 111 CASE DEFAULT ; CALL ctl_stop( 'volbdy must be 0 or 1' ) 112 END SELECT 113 IF(lwp) WRITE(numout,*) 121 114 ELSE 122 IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries' 123 IF(lwp) WRITE(numout,*) ' ' 124 ENDIF 125 126 IF (ln_bdy_tides) THEN 127 IF(lwp) WRITE(numout,*) ' ' 115 IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries' 116 IF(lwp) WRITE(numout,*) 117 ENDIF 118 119 IF( ln_bdy_tides ) THEN 128 120 IF(lwp) WRITE(numout,*) 'Tidal harmonic forcing at unstructured open boundaries' 129 IF(lwp) WRITE(numout,*) ' ' 130 ENDIF 131 132 IF (ln_bdy_dyn_fla) THEN 133 IF(lwp) WRITE(numout,*) ' ' 121 IF(lwp) WRITE(numout,*) 122 ENDIF 123 124 IF( ln_bdy_dyn_fla ) THEN 134 125 IF(lwp) WRITE(numout,*) 'Flather condition on U, V at unstructured open boundaries' 135 IF(lwp) WRITE(numout,*) ' ' 136 ENDIF 137 138 IF (ln_bdy_dyn_frs) THEN 139 IF(lwp) WRITE(numout,*) ' ' 126 IF(lwp) WRITE(numout,*) 127 ENDIF 128 129 IF( ln_bdy_dyn_frs ) THEN 140 130 IF(lwp) WRITE(numout,*) 'FRS condition on U and V at unstructured open boundaries' 141 IF(lwp) WRITE(numout,*) ' ' 142 ENDIF 143 144 IF (ln_bdy_tra_frs) THEN 145 IF(lwp) WRITE(numout,*) ' ' 131 IF(lwp) WRITE(numout,*) 132 ENDIF 133 134 IF( ln_bdy_tra_frs ) THEN 146 135 IF(lwp) WRITE(numout,*) 'FRS condition on T & S fields at unstructured open boundaries' 147 IF(lwp) WRITE(numout,*) ' ' 148 ENDIF 149 150 ! Read tides namelist 151 ! ------------------------ 152 IF( ln_bdy_tides ) CALL tide_init 136 IF(lwp) WRITE(numout,*) 137 ENDIF 138 139 IF( ln_bdy_ice_frs ) THEN 140 IF(lwp) WRITE(numout,*) 'FRS condition on ice fields at unstructured open boundaries' 141 IF(lwp) WRITE(numout,*) 142 ENDIF 143 144 IF( ln_bdy_tides ) CALL tide_init ! Read tides namelist 145 153 146 154 147 ! Read arrays defining unstructured open boundaries … … 160 153 ! = 0 elsewhere 161 154 162 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 155 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN ! EEL configuration at 5km resolution 163 156 zmask( : ,:) = 0.e0 164 157 zmask(jpizoom+1:jpizoom+jpiglo-2,:) = 1.e0 165 ELSE IF 158 ELSE IF( ln_bdy_mask ) THEN 166 159 CALL iom_open( filbdy_mask, inum ) 167 160 CALL iom_get ( inum, jpdom_data, 'bdy_msk', zmask(:,:) ) … … 171 164 ENDIF 172 165 173 ! Save mask over local domain 174 DO ij = 1, nlcj 166 DO ij = 1, nlcj ! Save mask over local domain 175 167 DO ii = 1, nlci 176 168 bdytmask(ii,ij) = zmask( mig(ii), mjg(ij) ) … … 187 179 END DO 188 180 END DO 189 190 ! Lateral boundary conditions 191 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) 192 CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 181 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) ! Lateral boundary cond. 182 193 183 194 184 ! Read discrete distance and mapping indices … … 200 190 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 201 191 icount = 0 202 ! Define west boundary (from ii=2 to ii=1+nb_rimwidth): 203 DO ir = 1, nb_rimwidth 192 DO ir = 1, nb_rimwidth ! Define west boundary (from ii=2 to ii=1+nb_rimwidth): 204 193 DO ij = 3, jpjglo-2 205 icount =icount+1194 icount = icount + 1 206 195 nbidta(icount,:) = ir + 1 + (jpizoom-1) 207 nbjdta(icount,:) = ij + (jpjzoom-1)196 nbjdta(icount,:) = ij + (jpjzoom-1) 208 197 nbrdta(icount,:) = ir 209 198 END DO 210 199 END DO 211 212 ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nb_rimwidth): 213 DO ir=1,nb_rimwidth 200 ! 201 DO ir = 1, nb_rimwidth ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nb_rimwidth): 214 202 DO ij=3,jpjglo-2 215 icount =icount+1203 icount = icount + 1 216 204 nbidta(icount,:) = jpiglo-ir + (jpizoom-1) 217 205 nbidta(icount,2) = jpiglo-ir-1 + (jpizoom-1) ! special case for u points … … 220 208 END DO 221 209 END DO 222 210 ! 223 211 ELSE ! Read indices and distances in unstructured boundary data files 224 225 IF( ln_bdy_tides ) THEN 226 ! Read tides input files for preference in case there are 227 ! no bdydata files. 228 clfile(1) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc' 229 clfile(2) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc' 230 clfile(3) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc' 231 ELSE 212 ! 213 IF( ln_bdy_tides ) THEN ! Read tides input files for preference in case there are no bdydata files 214 clfile(4) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc' 215 clfile(5) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc' 216 clfile(6) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc' 217 ENDIF 218 IF( ln_bdy_dyn_fla .AND. .NOT. ln_bdy_tides ) THEN 219 clfile(4) = filbdy_data_bt_T 220 clfile(5) = filbdy_data_bt_U 221 clfile(6) = filbdy_data_bt_V 222 ENDIF 223 224 IF( ln_bdy_tra_frs ) THEN 232 225 clfile(1) = filbdy_data_T 226 IF( .NOT. ln_bdy_dyn_frs ) THEN 227 clfile(2) = filbdy_data_T ! Dummy read re read T file for sake of 6 files 228 clfile(3) = filbdy_data_T ! 229 ENDIF 230 ENDIF 231 IF( ln_bdy_dyn_frs ) THEN 232 IF( .NOT. ln_bdy_tra_frs ) clfile(1) = filbdy_data_U ! Dummy Read 233 233 clfile(2) = filbdy_data_U 234 clfile(3) = filbdy_data_V 235 ENDIF 236 237 ! how many files are we to read in?238 igrd_start = 1239 igrd_end = 3240 IF( .NOT. ln_bdy_tides ) THEN241 IF(.NOT. (ln_bdy_dyn_fla) .AND..NOT. (ln_bdy_tra_frs)) THEN242 ! No T-grid file.243 igrd_start = 2244 ELSEIF ( .NOT. ln_bdy_dyn_frs .AND..NOT. ln_bdy_dyn_fla ) THEN245 ! No U-grid or V-grid file.246 igrd_end = 1247 ENDIF234 clfile(3) = filbdy_data_V 235 ENDIF 236 237 ! ! how many files are we to read in? 238 IF(ln_bdy_tides .OR. ln_bdy_dyn_fla) igrd_start = 4 239 ! 240 IF(ln_bdy_tra_frs ) THEN ; igrd_start = 1 241 ELSEIF(ln_bdy_dyn_frs) THEN ; igrd_start = 2 242 ENDIF 243 ! 244 IF( ln_bdy_tra_frs ) igrd_end = 1 245 ! 246 IF(ln_bdy_dyn_fla .OR. ln_bdy_tides) THEN ; igrd_end = 6 247 ELSEIF( ln_bdy_dyn_frs ) THEN ; igrd_end = 3 248 248 ENDIF 249 249 … … 251 251 CALL iom_open( clfile(igrd), inum ) 252 252 id_dummy = iom_varid( inum, 'nbidta', kdimsz=kdimsz ) 253 WRITE(numout,*) 'kdimsz : ',kdimsz253 IF(lwp) WRITE(numout,*) 'kdimsz : ',kdimsz 254 254 ib_len = kdimsz(1) 255 IF( ib_len > jpbdta) CALL ctl_stop( & 256 'Boundary data array in file too long.', & 257 'File :', TRIM(clfile(igrd)), & 258 'increase parameter jpbdta.' ) 255 IF( ib_len > jpbdta) CALL ctl_stop( 'Boundary data array in file too long.', & 256 & 'File :', TRIM(clfile(igrd)),'increase parameter jpbdta.' ) 259 257 260 258 CALL iom_get( inum, jpdom_unknown, 'nbidta', zdta(1:ib_len,:) ) … … 264 262 CALL iom_get( inum, jpdom_unknown, 'nbjdta', zdta(1:ib_len,:) ) 265 263 DO ii = 1,ib_len 266 nbjdta(ii,igrd) = INT( zdta(ii,1) )267 END DO 268 CALL iom_get 264 nbjdta(ii,igrd) = INT( zdta(ii,1) ) 265 END DO 266 CALL iom_get( inum, jpdom_unknown, 'nbrdta', zdta(1:ib_len,:) ) 269 267 DO ii = 1,ib_len 270 nbrdta(ii,igrd) = INT( zdta(ii,1) )268 nbrdta(ii,igrd) = INT( zdta(ii,1) ) 271 269 END DO 272 270 CALL iom_close( inum ) 273 271 274 ! Check that rimwidth in file is big enough:275 ibr_max = MAXVAL( nbrdta(:,igrd) )276 IF(lwp) WRITE(numout,*)277 IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max278 IF(lwp) WRITE(numout,*) ' nb_rimwidth from namelist is ', nb_rimwidth279 IF (ibr_max < nb_rimwidth) CALL ctl_stop( &280 'nb_rimwidth is larger than maximum rimwidth in file' )272 IF( igrd < 4) THEN ! Check that rimwidth in file is big enough for Frs case(barotropic is one): 273 ibr_max = MAXVAL( nbrdta(:,igrd) ) 274 IF(lwp) WRITE(numout,*) 275 IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max 276 IF(lwp) WRITE(numout,*) ' nb_rimwidth from namelist is ', nb_rimwidth 277 IF (ibr_max < nb_rimwidth) CALL ctl_stop( 'nb_rimwidth is larger than maximum rimwidth in file' ) 278 ENDIF !Check igrd < 4 281 279 ! 282 280 END DO … … 293 291 294 292 DO igrd = igrd_start, igrd_end 295 icount = 0296 icountr = 0297 nblen(igrd) = 0298 nblenrim(igrd) = 0299 nblendta(igrd) = 0300 DO ir=1, nb_rimwidth301 DO ib = 1, jpbdta302 ! check if point is in local domain and equals ir303 IF( nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND. &304 & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND. &305 & nbrdta(ib,igrd) == ir ) THEN306 !307 icount = icount + 1308 !309 IF( ir == 1 ) icountr = icountr+1293 icount = 0 294 icountr = 0 295 nblen (igrd) = 0 296 nblenrim(igrd) = 0 297 nblendta(igrd) = 0 298 DO ir=1, nb_rimwidth 299 DO ib = 1, jpbdta 300 ! check if point is in local domain and equals ir 301 IF( nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND. & 302 & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND. & 303 & nbrdta(ib,igrd) == ir ) THEN 304 ! 305 icount = icount + 1 306 ! 307 IF( ir == 1 ) icountr = icountr+1 310 308 IF (icount > jpbdim) THEN 311 309 IF(lwp) WRITE(numout,*) 'bdy_ini: jpbdim too small' … … 328 326 DO igrd = igrd_start, igrd_end 329 327 DO ib = 1, nblen(igrd) 330 ! tanh formulation 331 nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 ) 332 ! quadratic 333 ! nbw(ib,igrd) = (FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth))**2 334 ! linear 335 ! nbw(ib,igrd) = FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth) 328 nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 ) ! tanh formulation 329 ! nbw(ib,igrd) = (FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth))**2 ! quadratic 330 ! nbw(ib,igrd) = FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth) ! linear 336 331 END DO 337 332 END DO … … 384 379 385 380 ! Lateral boundary conditions 386 CALL lbc_lnk( fmask , 'F', 1. ) 387 CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 388 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) 389 CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 381 CALL lbc_lnk( fmask , 'F', 1. ) ; CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 382 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 390 383 391 384 IF( ln_bdy_vol .OR. ln_bdy_dyn_fla ) THEN ! Indices and directions of rim velocity components … … 437 430 ! Compute total lateral surface for volume correction: 438 431 ! ---------------------------------------------------- 439 440 432 bdysurftot = 0.e0 441 433 IF( ln_bdy_vol ) THEN … … 455 447 & * tmask_i(nbi(ib,igrd),nbj(ib,igrd)+1) 456 448 END DO 457 449 ! 458 450 IF( lk_mpp ) CALL mpp_sum( bdysurftot ) ! sum over the global domain 459 451 END IF … … 468 460 ubtbdy(:) = 0.e0 469 461 vbtbdy(:) = 0.e0 462 #if defined key_lim2 463 frld_bdy(:) = 0.e0 464 hicif_bdy(:) = 0.e0 465 hsnif_bdy(:) = 0.e0 466 #endif 470 467 471 468 ! Read in tidal constituents and adjust for model start time -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdytides.F90
- Property svn:executable deleted
r1715 r2236 7 7 !! 2.3 ! 2008-01 (J.Holt) Add date correction. Origins POLCOMS v6.3 2007 8 8 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 9 !! 3.3 ! 2010-09 (D.Storkey and E.O'Dea) bug fixes 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_bdy … … 31 32 USE bdy_par ! Unstructured boundary parameters 32 33 USE bdy_oce ! ocean open boundary conditions 34 USE daymod ! calendar 33 35 34 36 IMPLICIT NONE … … 39 41 PUBLIC tide_update ! routine called in bdydyn 40 42 41 LOGICAL, PUBLIC :: ln_tide_date !: =T correct tide phases and amplitude for model start date 42 43 INTEGER, PARAMETER :: jptides_max = 15 !: Max number of tidal contituents 44 INTEGER :: ntide !: Actual number of tidal constituents 43 LOGICAL, PUBLIC :: ln_tide_date !: =T correct tide phases and amplitude for model start date 44 INTEGER, PUBLIC, PARAMETER :: jptides_max = 15 !: Max number of tidal contituents 45 INTEGER, PUBLIC :: ntide !: Actual number of tidal constituents 45 46 46 47 CHARACTER(len=80), PUBLIC :: filtide !: Filename root for tidal input files 47 48 CHARACTER(len= 4), PUBLIC, DIMENSION(jptides_max) :: tide_cpt !: Names of tidal components used. 48 49 49 INTEGER , DIMENSION(jptides_max) :: nindx !: ???50 REAL(wp), DIMENSION(jptides_max) :: tide_speed !: Phase speed of tidal constituent (deg/hr)50 INTEGER , PUBLIC, DIMENSION(jptides_max) :: nindx !: ??? 51 REAL(wp), PUBLIC, DIMENSION(jptides_max) :: tide_speed !: Phase speed of tidal constituent (deg/hr) 51 52 52 REAL(wp), DIMENSION(jpbdim,jptides_max) :: ssh1, ssh2 ! :Tidal constituents : SSH53 REAL(wp), DIMENSION(jpbdim,jptides_max) :: u1 , u2 ! :Tidal constituents : U54 REAL(wp), DIMENSION(jpbdim,jptides_max) :: v1 , v2 ! :Tidal constituents : V53 REAL(wp), DIMENSION(jpbdim,jptides_max) :: ssh1, ssh2 ! Tidal constituents : SSH 54 REAL(wp), DIMENSION(jpbdim,jptides_max) :: u1 , u2 ! Tidal constituents : U 55 REAL(wp), DIMENSION(jpbdim,jptides_max) :: v1 , v2 ! Tidal constituents : V 55 56 56 57 !!---------------------------------------------------------------------- 57 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)58 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 58 59 !! $Id$ 59 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)60 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 60 61 !!---------------------------------------------------------------------- 61 62 62 CONTAINS 63 63 … … 87 87 ! ! Count number of components specified 88 88 ntide = jptides_max 89 itide = 1 90 DO WHILE( tide_cpt(itide) /= '' ) 91 ntide = itide 92 itide = itide + 1 89 DO itide = 1, jptides_max 90 IF( tide_cpt(itide) == '' ) THEN 91 ntide = itide-1 92 exit 93 ENDIF 93 94 END DO 95 94 96 ! ! find constituents in standard list 95 97 DO itide = 1, ntide … … 145 147 CHARACTER(len=80) :: clfile ! full file name for tidal input file 146 148 INTEGER :: ipi, ipj, inum, idvar ! temporary integers (netcdf read) 147 INTEGER, DIMENSION( 3) :: lendta=0 ! length of data in the file (note may be different from nblendta!)149 INTEGER, DIMENSION(6) :: lendta=0 ! length of data in the file (note may be different from nblendta!) 148 150 REAL(wp) :: z_arg, z_atde, z_btde, z1t, z2t 149 151 REAL(wp), DIMENSION(jpbdta,1) :: zdta ! temporary array for data fields … … 161 163 IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 162 164 CALL iom_open( clfile, inum ) 163 igrd = 1165 igrd = 4 164 166 IF( nblendta(igrd) <= 0 ) THEN 165 167 idvar = iom_varid( inum,'z1' ) … … 183 185 IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 184 186 CALL iom_open( clfile, inum ) 185 igrd = 2187 igrd = 5 186 188 IF( lendta(igrd) <= 0 ) THEN 187 189 idvar = iom_varid( inum,'u1' ) … … 204 206 if(lwp) write(numout,*) 'Reading data from file ', clfile 205 207 CALL iom_open( clfile, inum ) 206 igrd = 3208 igrd = 6 207 209 IF( lendta(igrd) <= 0 ) THEN 208 210 idvar = iom_varid( inum,'v1' ) … … 252 254 ENDIF 253 255 ! ! elevation 254 igrd = 1256 igrd = 4 255 257 DO ib = 1, nblenrim(igrd) 256 258 z1t = z_atde * ssh1(ib,itide) + z_btde * ssh2(ib,itide) … … 260 262 END DO 261 263 ! ! u 262 igrd = 2264 igrd = 5 263 265 DO ib = 1, nblenrim(igrd) 264 266 z1t = z_atde * u1(ib,itide) + z_btde * u2(ib,itide) … … 268 270 END DO 269 271 ! ! v 270 igrd = 3272 igrd = 6 271 273 DO ib = 1, nblenrim(igrd) 272 274 z1t = z_atde * v1(ib,itide) + z_btde * v2(ib,itide) … … 320 322 ! 321 323 DO itide = 1, ntide 322 igrd= 1! SSH on tracer grid.324 igrd=4 ! SSH on tracer grid. 323 325 DO ib = 1, nblenrim(igrd) 324 326 sshtide(ib) =sshtide(ib)+ ssh1(ib,itide)*z_cost(itide) + ssh2(ib,itide)*z_sist(itide) 325 327 ! if(lwp) write(numout,*) 'z',ib,itide,sshtide(ib), ssh1(ib,itide),ssh2(ib,itide) 326 328 END DO 327 igrd= 2! U grid329 igrd=5 ! U grid 328 330 DO ib=1, nblenrim(igrd) 329 331 utide(ib) = utide(ib)+ u1(ib,itide)*z_cost(itide) + u2(ib,itide)*z_sist(itide) 330 332 ! if(lwp) write(numout,*) 'u',ib,itide,utide(ib), u1(ib,itide),u2(ib,itide) 331 333 END DO 332 igrd= 3! V grid334 igrd=6 ! V grid 333 335 DO ib=1, nblenrim(igrd) 334 336 vtide(ib) = vtide(ib)+ v1(ib,itide)*z_cost(itide) + v2(ib,itide)*z_sist(itide) -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdytra.F90
- Property svn:executable deleted
r1146 r2236 25 25 26 26 !!---------------------------------------------------------------------- 27 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)27 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 28 28 !! $Id$ 29 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)29 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 30 30 !!---------------------------------------------------------------------- 31 32 31 CONTAINS 33 32 … … 48 47 !!---------------------------------------------------------------------- 49 48 ! 50 IF(ln_bdy_tra_frs) THEN ! If this is false, then this routine does nothing. 51 52 IF( kt == nit000 ) THEN 53 IF(lwp) WRITE(numout,*) 54 IF(lwp) WRITE(numout,*) 'bdy_tra : Flow Relaxation Scheme for tracers' 55 IF(lwp) WRITE(numout,*) '~~~~~~~' 56 ENDIF 49 IF(ln_bdy_tra_frs) THEN ! If this is false, then this routine does nothing. 50 ! 51 IF( kt == nit000 ) THEN 52 IF(lwp) WRITE(numout,*) 53 IF(lwp) WRITE(numout,*) 'bdy_tra : Flow Relaxation Scheme for tracers' 54 IF(lwp) WRITE(numout,*) '~~~~~~~' 55 ENDIF 56 ! 57 igrd = 1 ! Everything is at T-points here 58 DO ib = 1, nblen(igrd) 59 DO ik = 1, jpkm1 60 ii = nbi(ib,igrd) 61 ij = nbj(ib,igrd) 62 zwgt = nbw(ib,igrd) 63 ta(ii,ij,ik) = ( ta(ii,ij,ik) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik) 64 sa(ii,ij,ik) = ( sa(ii,ij,ik) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik) 65 END DO 66 END DO 67 ! 68 CALL lbc_lnk( ta, 'T', 1. ) ; CALL lbc_lnk( sa, 'T', 1. ) ! Boundary points should be updated 69 ! 70 ENDIF ! ln_bdy_tra_frs 57 71 ! 58 igrd = 1 ! Everything is at T-points here59 DO ib = 1, nblen(igrd)60 DO ik = 1, jpkm161 ii = nbi(ib,igrd)62 ij = nbj(ib,igrd)63 zwgt = nbw(ib,igrd)64 ta(ii,ij,ik) = ( ta(ii,ij,ik) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)65 sa(ii,ij,ik) = ( sa(ii,ij,ik) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)66 END DO67 END DO68 !69 CALL lbc_lnk( ta, 'T', 1. ) ! Boundary points should be updated70 CALL lbc_lnk( sa, 'T', 1. ) !71 !72 ENDIF ! ln_bdy_tra_frs73 74 72 END SUBROUTINE bdy_tra 75 73 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyvol.F90
- Property svn:executable deleted
r2000 r2236 11 11 #if defined key_bdy && defined key_dynspg_flt 12 12 !!---------------------------------------------------------------------- 13 !! 'key_bdy' andunstructured open boundary conditions13 !! 'key_bdy' AND unstructured open boundary conditions 14 14 !! 'key_dynspg_flt' filtered free surface 15 15 !!---------------------------------------------------------------------- … … 30 30 # include "domzgr_substitute.h90" 31 31 !!---------------------------------------------------------------------- 32 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)32 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 33 33 !! $Id$ 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)34 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 35 35 !!---------------------------------------------------------------------- 36 37 36 CONTAINS 38 37 … … 73 72 INTEGER :: ji, jj, jk, jb, jgrd 74 73 INTEGER :: ii, ij 75 REAL(wp) :: zubtpecor, z_cflxemp, ztranst , zraur74 REAL(wp) :: zubtpecor, z_cflxemp, ztranst 76 75 !!----------------------------------------------------------------------------- 77 76 … … 84 83 ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 85 84 ! ----------------------------------------------------------------------- 86 z_cflxemp = 0.e0 87 zraur = 1.e0 / rau0 88 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) * zraur ) 89 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 85 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 86 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 90 87 91 ! Barotropic velocitythrough the unstructured open boundary92 ! ------------------------------------------------ ----------88 ! Transport through the unstructured open boundary 89 ! ------------------------------------------------ 93 90 zubtpecor = 0.e0 94 91 jgrd = 2 ! cumulate u component contribution first … … 112 109 ! The normal velocity correction 113 110 ! ------------------------------ 114 IF (volbdy==1) THEN ; zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot115 ELSE ; zubtpecor = zubtpecor / bdysurftot111 IF( volbdy==1 ) THEN ; zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 112 ELSE ; zubtpecor = zubtpecor / bdysurftot 116 113 END IF 117 114 … … 141 138 ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected 142 139 ! ------------------------------------------------------ 143 144 140 IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 145 141 IF(lwp) WRITE(numout,*) -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diaar5.F90
r2104 r2236 39 39 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 40 40 !! $Id$ 41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)41 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 42 42 !!---------------------------------------------------------------------- 43 43 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diafwb.F90
r2000 r2236 40 40 !! OPA 9.0 , LOCEAN-IPSL (2006) 41 41 !! $Id$ 42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)42 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- 44 44 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diagap.F90
r1715 r2236 47 47 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 48 48 !! $Id$ 49 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)49 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 50 50 !!---------------------------------------------------------------------- 51 51 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diahth.F90
r1585 r2236 44 44 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 45 45 !! $Id$ 46 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)46 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 47 47 !!---------------------------------------------------------------------- 48 48 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diaptr.F90
r1970 r2236 102 102 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 103 103 !! $Id$ 104 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)104 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 105 105 !!---------------------------------------------------------------------- 106 106 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diawri.F90
r2000 r2236 30 30 USE limwri_2 31 31 #endif 32 USE dtatem 33 USE dtasal 34 32 35 IMPLICIT NONE 33 36 PRIVATE -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/closea.F90
r2000 r2236 46 46 !! OPA 9.0 , LOCEAN-IPSL (2006) 47 47 !! $Id$ 48 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)48 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 49 49 !!---------------------------------------------------------------------- 50 50 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/daymod.F90
r2200 r2236 45 45 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 46 46 !! $Id$ 47 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)47 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 48 48 !!---------------------------------------------------------------------- 49 49 … … 67 67 !! - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 68 68 !!---------------------------------------------------------------------- 69 INTEGER :: inbday, irest 70 REAL(wp) :: zjul 71 !!---------------------------------------------------------------------- 69 72 70 73 ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0 … … 105 108 ! day since january 1st 106 109 nday_year = nday + SUM( nmonth_len(1:nmonth - 1) ) 107 110 111 !compute number of days between last monday and today 112 IF( nn_leapy==1 )THEN 113 CALL ymds2ju( 1900, 01, 01, 0.0, zjul ) ! compute julian day value of 01.01.1900 (monday) 114 inbday = INT(fjulday) - NINT(zjul) ! compute nb day between 01.01.1900 and current day fjulday 115 irest = MOD(inbday,7) ! compute nb day between last monday and current day fjulday 116 IF(irest==0 )irest = 7 117 ENDIF 118 108 119 ! number of seconds since the beginning of current year/month at the middle of the time-step 109 120 nsec_year = nday_year * nsecd - ndt05 ! 1 time step before the middle of the first time step 110 121 nsec_month = nday * nsecd - ndt05 ! because day will be called at the beginning of step 111 122 nsec_day = nsecd - ndt05 123 nsec_week = 0 124 IF( nn_leapy==1 ) nsec_week = irest * nsecd - ndt05 112 125 113 126 ! control print 114 127 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ', & 115 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day 128 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day, ' nsec_week:', nsec_week 116 129 117 130 ! Up to now, calendar parameters are related to the end of previous run (nit000-1) … … 200 213 nsec_year = nsec_year + ndt 201 214 nsec_month = nsec_month + ndt 215 IF( nn_leapy==1 ) nsec_week = nsec_week + ndt 202 216 nsec_day = nsec_day + ndt 203 217 adatrj = adatrj + rdttra(1) / rday … … 228 242 ndastp = nyear * 10000 + nmonth * 100 + nday ! NEW date 229 243 ! 244 !compute first day of the year in julian days 245 CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear ) 246 ! 230 247 IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt, & 231 248 & ' New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, ' nday_year = ', nday_year 232 249 IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') ' nsec_year = ', nsec_year, & 233 & ' nsec_month = ', nsec_month, ' nsec_day = ', nsec_day 234 ENDIF 250 & ' nsec_month = ', nsec_month, ' nsec_day = ', nsec_day, ' nsec_week = ', nsec_week 251 ENDIF 252 253 IF( nsec_week .GT. 7*86400 ) nsec_week = ndt05 235 254 236 255 IF(ln_ctl) THEN -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/dom_oce.F90
r2148 r2236 9 9 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 10 10 !! $Id$ 11 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)11 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 12 12 !!---------------------------------------------------------------------- 13 13 USE par_oce ! ocean parameters … … 197 197 !! calendar variables 198 198 !! --------------------------------------------------------------------- 199 INTEGER , PUBLIC :: nyear !: current year 200 INTEGER , PUBLIC :: nmonth !: current month 201 INTEGER , PUBLIC :: nday !: current day of the month 202 INTEGER , PUBLIC :: ndastp !: time step date in yyyymmdd format 203 INTEGER , PUBLIC :: nday_year !: current day counted from jan 1st of the current year 204 INTEGER , PUBLIC :: nsec_year !: current time step counted in second since 00h jan 1st of the current year 205 INTEGER , PUBLIC :: nsec_month !: current time step counted in second since 00h 1st day of the current month 206 INTEGER , PUBLIC :: nsec_day !: current time step counted in second since 00h of the current day 207 REAL(wp), PUBLIC :: fjulday !: julian day 208 REAL(wp), PUBLIC :: adatrj !: number of elapsed days since the begining of the whole simulation 209 ! !: (cumulative duration of previous runs that may have used different time-step size) 199 INTEGER , PUBLIC :: nyear !: current year 200 INTEGER , PUBLIC :: nmonth !: current month 201 INTEGER , PUBLIC :: nday !: current day of the month 202 INTEGER , PUBLIC :: ndastp !: time step date in yyyymmdd format 203 INTEGER , PUBLIC :: nday_year !: current day counted from jan 1st of the current year 204 INTEGER , PUBLIC :: nsec_year !: current time step counted in second since 00h jan 1st of the current year 205 INTEGER , PUBLIC :: nsec_month !: current time step counted in second since 00h 1st day of the current month 206 INTEGER , PUBLIC :: nsec_week !: current time step counted in second since 00h of last monday 207 INTEGER , PUBLIC :: nsec_day !: current time step counted in second since 00h of the current day 208 REAL(wp), PUBLIC :: fjulday !: current julian day 209 REAL(wp), PUBLIC :: fjulstartyear !: first day of the current year in julian days 210 REAL(wp), PUBLIC :: adatrj !: number of elapsed days since the begining of the whole simulation 211 ! !: (cumulative duration of previous runs that may have used different time-step size) 210 212 INTEGER , PUBLIC, DIMENSION(0: 1) :: nyear_len !: length in days of the previous/current year 211 213 INTEGER , PUBLIC, DIMENSION(0:13) :: nmonth_len !: length in days of the months of the current year … … 230 232 LOGICAL, PUBLIC, PARAMETER :: lk_agrif = .FALSE. !: agrif flag 231 233 234 !!---------------------------------------------------------------------- 235 !! mpp reproducibility 236 !!---------------------------------------------------------------------- 237 #if defined key_mpp_rep1 || defined key_mpp_re2 238 LOGICAL, PUBLIC, PARAMETER :: lk_mpp_rep = .TRUE. !: agrif flag 239 #else 240 LOGICAL, PUBLIC, PARAMETER :: lk_mpp_rep = .FALSE. !: agrif flag 241 #endif 242 232 243 CONTAINS 233 244 LOGICAL FUNCTION Agrif_Root() … … 239 250 END FUNCTION Agrif_CFixed 240 251 #endif 241 242 252 !!====================================================================== 243 253 END MODULE dom_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domain.F90
r1976 r2236 43 43 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 44 44 !! $Id$ 45 !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)45 !! Software is governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 46 46 !!------------------------------------------------------------------------- 47 47 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domcfg.F90
r1566 r2236 24 24 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 25 25 !! $Id$ 26 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)26 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 27 27 !!---------------------------------------------------------------------- 28 28 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domhgr.F90
r1953 r2236 40 40 !! OPA 9.0 , LOCEAN-IPSL (2005) 41 41 !! $Id$ 42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)42 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- 44 44 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/dommsk.F90
r1707 r2236 44 44 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 45 45 !! $Id$ 46 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)46 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 47 47 !!---------------------------------------------------------------------- 48 48 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domngb.F90
r1725 r2236 21 21 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2008) 22 22 !! $Id$ 23 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)23 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 24 24 !!---------------------------------------------------------------------- 25 25 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domstp.F90
r1152 r2236 29 29 !! OPA 9.0 , LOCEAN-IPSL (2005) 30 30 !! $Id$ 31 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)31 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 32 32 !!---------------------------------------------------------------------- 33 33 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domvvl.F90
r2148 r2236 38 38 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)40 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 41 41 !!---------------------------------------------------------------------- 42 42 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domzgr.F90
r1694 r2236 34 34 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 35 35 USE closea ! closed seas 36 USE c1d ! 1D configuration37 36 38 37 IMPLICIT NONE … … 59 58 !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 60 59 !! $Id$ 61 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)60 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 62 61 !!---------------------------------------------------------------------- 63 62 … … 482 481 ! ! =============== ! 483 482 484 ! ! =================== ! 485 IF( .NOT. lk_c1d ) CALL zgr_bat_ctl ! Bathymetry check ! 486 ! ! =================== ! 483 #if ! defined key_c1d 484 ! ! =================== ! 485 CALL zgr_bat_ctl ! Bathymetry check ! 486 ! ! =================== ! 487 #endif 487 488 END SUBROUTINE zgr_bat 488 489 … … 984 985 ! ! =============== ! 985 986 986 ! ! =================== ! 987 IF( .NOT. lk_c1d ) CALL zgr_bat_ctl ! Bathymetry check ! 988 ! ! =================== ! 987 #if ! defined key_c1d 988 ! ! =================== ! 989 CALL zgr_bat_ctl ! Bathymetry check ! 990 ! ! =================== ! 991 #endif 989 992 END SUBROUTINE zgr_zps 990 993 … … 1476 1479 ! ! =========== 1477 1480 1478 ! ! =================== ! 1479 IF( .NOT. lk_c1d ) CALL zgr_bat_ctl ! Bathymetry check ! 1480 ! ! =================== ! 1481 #if ! defined key_c1d 1482 ! ! =================== ! 1483 CALL zgr_bat_ctl ! Bathymetry check ! 1484 ! ! =================== ! 1485 #endif 1481 1486 1482 1487 ! ! ============= -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domzgr_substitute.h90
r2148 r2236 108 108 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 109 109 !! $Id$ 110 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)110 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 111 111 !!---------------------------------------------------------------------- -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/phycst.F90
r2224 r2236 83 83 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 84 84 !! $Id$ 85 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)85 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 86 86 !!---------------------------------------------------------------------- 87 87 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DTA/dtasal.F90
r2104 r2236 63 63 !! 9.0 ! 02-06 (G. Madec) F90: Free form and module 64 64 !!---------------------------------------------------------------------- 65 66 !! * Arguments67 65 INTEGER, INTENT(in) :: kt ! ocean time step 68 66 69 !! * Local declarations70 67 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 71 68 INTEGER :: ik, ierror ! temporary integers … … 74 71 #endif 75 72 REAL(wp):: zl 73 76 74 #if defined key_orca_lev10 77 75 INTEGER :: ikr, ikw, ikt, jjk … … 109 107 CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' ) ; RETURN 110 108 ENDIF 111 #if defined key_orca_lev10 112 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpkdta ) ) 113 ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpkdta,2) ) 109 110 #if defined key_orca_lev10 111 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpkdta) ) 112 IF( sn_sal%ln_tint ) ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpkdta,2) ) 114 113 #else 115 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk ) ) 116 ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 117 #endif 118 114 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk) ) 115 IF( sn_sal%ln_tint ) ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 116 #endif 119 117 ! fill sf_sal with sn_sal and control print 120 118 CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' ) … … 122 120 ENDIF 123 121 124 125 122 ! 2. Read monthly file 126 123 ! ------------------- … … 128 125 CALL fld_read( kt, 1, sf_sal ) 129 126 130 IF( lwp .AND. kt ==nn_it000 ) THEN127 IF( lwp .AND. kt == nit000 ) THEN 131 128 WRITE(numout,*) 132 129 WRITE(numout,*) ' read Levitus salinity ok' … … 247 244 ENDIF 248 245 249 IF( lwp .AND. kt ==nn_it000 ) THEN246 IF( lwp .AND. kt == nit000 ) THEN 250 247 WRITE(numout,*)' salinity Levitus ' 251 248 WRITE(numout,*) -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DTA/dtatem.F90
r2104 r2236 69 69 !! 8.5 ! 02-09 (G. Madec) F90: Free form and module 70 70 !!---------------------------------------------------------------------- 71 !! * Arguments72 71 INTEGER, INTENT( in ) :: kt ! ocean time-step 73 72 74 !! * Local declarations75 73 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 76 74 INTEGER :: ik, ierror ! temporary integers … … 102 100 sn_tem = FLD_N( 'temperature', -1. , 'votemper', .false. , .true. , 'yearly' , '' , '' ) 103 101 104 REWIND( numnam ) 102 REWIND( numnam ) ! ... read in namlist namdta_tem 105 103 READ( numnam, namdta_tem ) 106 104 107 IF(lwp) THEN 105 IF(lwp) THEN ! control print 108 106 WRITE(numout,*) 109 107 WRITE(numout,*) 'dta_tem : Temperature Climatology ' … … 116 114 117 115 #if defined key_orca_lev10 118 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta ))119 ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) )116 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta) ) 117 IF( sn_tem%ln_tint ) ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) ) 120 118 #else 121 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk ))122 ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) )119 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk) ) 120 IF( sn_tem%ln_tint ) ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 123 121 #endif 124 122 ! fill sf_tem with sn_tem and control print 125 123 CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' ) 126 124 linit_tem = .TRUE. 127 125 ! 128 126 ENDIF 129 127 … … 133 131 CALL fld_read( kt, 1, sf_tem ) 134 132 135 IF( lwp .AND. kt ==nn_it000 )THEN133 IF( lwp .AND. kt == nit000 )THEN 136 134 WRITE(numout,*) 137 135 WRITE(numout,*) ' read Levitus temperature ok' … … 141 139 #if defined key_tradmp 142 140 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 143 144 141 ! ! ======================= 145 142 ! ! ORCA_R2 configuration … … 236 233 END DO 237 234 238 IF( lwp .AND. kt ==nn_it000 )THEN235 IF( lwp .AND. kt == nit000 )THEN 239 236 WRITE(numout,*) 240 237 WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' … … 260 257 ENDIF 261 258 262 IF( lwp .AND. kt ==nn_it000 ) THEN259 IF( lwp .AND. kt == nit000 ) THEN 263 260 WRITE(numout,*) ' temperature Levitus ' 264 261 WRITE(numout,*) -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/divcur.F90
r2148 r2236 14 14 USE in_out_manager ! I/O manager 15 15 USE obc_oce ! ocean lateral open boundary condition 16 USE bdy_oce ! Unstructured open boundaries variables17 16 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 17 USE sbcrnf ! river runoff 18 USE sbc_oce, ONLY : ln_rnf ! surface boundary condition: ocean 18 19 19 20 IMPLICIT NONE … … 79 80 !! 9.0 ! 03-08 (G. Madec) merged of cur and div, free form, F90 80 81 !! ! 05-01 (J. Chanut, A. Sellar) unstructured open boundaries 82 !! NEMO 3.3 ! 2010-09 (D.Storkey and E.O'Dea) bug fixes for BDY module 81 83 !!---------------------------------------------------------------------- 82 84 !! * Arguments … … 132 134 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south 133 135 ENDIF 134 #endif135 #if defined key_bdy136 ! unstructured open boundaries (div must be zero behind the open boundary)137 DO jj = 1, jpj138 DO ji = 1, jpi139 hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj)140 END DO141 END DO142 136 #endif 143 137 IF( .NOT. AGRIF_Root() ) THEN … … 245 239 END DO ! End of slab 246 240 ! ! =============== 241 242 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 247 243 248 244 ! 4. Lateral boundary conditions on hdivn and rotn … … 346 342 ENDIF 347 343 #endif 348 #if defined key_bdy349 ! unstructured open boundaries (div must be zero behind the open boundary)350 DO jj = 1, jpj351 DO ji = 1, jpi352 hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj)353 END DO354 END DO355 #endif356 344 IF( .NOT. AGRIF_Root() ) THEN 357 345 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east … … 374 362 END DO ! End of slab 375 363 ! ! =============== 376 364 365 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 366 377 367 ! 4. Lateral boundary conditions on hdivn and rotn 378 368 ! ---------------------------------=======---====== -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynadv.F90
- Property svn:executable deleted
r2104 r2236 38 38 !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)40 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 41 41 !!---------------------------------------------------------------------- 42 42 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
- Property svn:executable deleted
r1566 r2236 31 31 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 32 32 !! $Id$ 33 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)33 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 34 34 !!---------------------------------------------------------------------- 35 35 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
- Property svn:executable deleted
r1566 r2236 36 36 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 37 37 !! $Id$ 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)38 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 39 39 !!---------------------------------------------------------------------- 40 40 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynbfr.F90
r1719 r2236 32 32 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 33 33 !! $Id: dynzdf.F90 1152 2008-06-26 14:11:13Z rblod $ 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)34 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 35 35 !!---------------------------------------------------------------------- 36 36 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynhpg.F90
r2104 r2236 63 63 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 64 64 !! $Id$ 65 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)65 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 66 66 !!---------------------------------------------------------------------- 67 67 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynkeg.F90
r1152 r2236 29 29 !! OPA 9.0 , LOCEAN-IPSL (2005) 30 30 !! $Id$ 31 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)31 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 32 32 !!---------------------------------------------------------------------- 33 33 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynldf.F90
- Property svn:executable deleted
r2104 r2236 33 33 PUBLIC dyn_ldf_init ! called by opa module 34 34 35 INTEGER :: nldf = 0! type of lateral diffusion used defined from ln_dynldf_... namlist logicals)35 INTEGER :: nldf = -2 ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals) 36 36 37 37 !! * Substitutions … … 41 41 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 42 42 !! $Id$ 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)43 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- 45 45 … … 68 68 CASE ( 2 ) ; CALL dyn_ldf_bilap ( kt ) ! iso-level bilaplacian 69 69 CASE ( 3 ) ; CALL dyn_ldf_bilapg ( kt ) ! s-coord. horizontal bilaplacian 70 CASE ( 4 ) ! iso-level laplacian + bilaplacian 71 CALL dyn_ldf_lap ( kt ) 72 CALL dyn_ldf_bilap ( kt ) 73 CASE ( 5 ) ! rotated laplacian + bilaplacian (s-coord) 74 CALL dyn_ldf_iso ( kt ) 75 CALL dyn_ldf_bilapg ( kt ) 70 76 ! 71 77 CASE ( -1 ) ! esopa: test all possibility with control print … … 82 88 CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask, & 83 89 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 90 ! 91 CASE ( -2 ) ! neither laplacian nor bilaplacian schemes used 92 IF( kt == nit000 ) THEN 93 IF(lwp) WRITE(numout,*) 94 IF(lwp) WRITE(numout,*) 'dyn_ldf : no lateral diffusion on momentum setup' 95 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 96 ENDIF 84 97 END SELECT 85 98 … … 123 136 IF( ln_dynldf_lap ) ioptio = ioptio + 1 124 137 IF( ln_dynldf_bilap ) ioptio = ioptio + 1 125 IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE of the 2 lap/bilap operator type ondynamics' )138 IF( ioptio < 1 ) CALL ctl_warn( ' neither laplacian nor bilaplacian operator set for dynamics' ) 126 139 ioptio = 0 127 140 IF( ln_dynldf_level ) ioptio = ioptio + 1 … … 143 156 IF ( ln_dynldf_iso ) nldf = 1 ! isoneutral ( rotation) 144 157 ENDIF 145 IF ( ln_sco ) THEN ! z-coordinate158 IF ( ln_sco ) THEN ! s-coordinate 146 159 IF ( ln_dynldf_level ) nldf = 0 ! iso-level (no rotation) 147 160 IF ( ln_dynldf_hor ) nldf = 1 ! horizontal ( rotation) … … 161 174 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation) 162 175 ENDIF 163 IF ( ln_sco ) THEN ! z-coordinate176 IF ( ln_sco ) THEN ! s-coordinate 164 177 IF ( ln_dynldf_level ) nldf = 2 ! iso-level (no rotation) 165 178 IF ( ln_dynldf_hor ) nldf = 3 ! horizontal ( rotation) … … 168 181 ENDIF 169 182 183 IF( ln_dynldf_lap .AND. ln_dynldf_bilap ) THEN ! mixed laplacian and bilaplacian operators 184 IF ( ln_zco ) THEN ! z-coordinate 185 IF ( ln_dynldf_level ) nldf = 4 ! iso-level (no rotation) 186 IF ( ln_dynldf_hor ) nldf = 4 ! horizontal (no rotation) 187 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation) 188 ENDIF 189 IF ( ln_zps ) THEN ! z-coordinate 190 IF ( ln_dynldf_level ) ierr = 1 ! iso-level not allowed 191 IF ( ln_dynldf_hor ) nldf = 4 ! horizontal (no rotation) 192 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation) 193 ENDIF 194 IF ( ln_sco ) THEN ! s-coordinate 195 IF ( ln_dynldf_level ) nldf = 4 ! iso-level (no rotation) 196 IF ( ln_dynldf_hor ) nldf = 5 ! horizontal ( rotation) 197 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation) 198 ENDIF 199 ENDIF 200 170 201 IF( lk_esopa ) nldf = -1 ! esopa test 171 202 … … 178 209 IF(lwp) THEN 179 210 WRITE(numout,*) 211 IF( nldf == -2 ) WRITE(numout,*) ' neither laplacian nor bilaplacian schemes used' 180 212 IF( nldf == -1 ) WRITE(numout,*) ' ESOPA test All scheme used' 181 213 IF( nldf == 0 ) WRITE(numout,*) ' laplacian operator' 182 IF( nldf == 1 ) WRITE(numout,*) ' Rotated laplacian operator'214 IF( nldf == 1 ) WRITE(numout,*) ' rotated laplacian operator' 183 215 IF( nldf == 2 ) WRITE(numout,*) ' bilaplacian operator' 184 IF( nldf == 3 ) WRITE(numout,*) ' Rotated bilaplacian' 216 IF( nldf == 3 ) WRITE(numout,*) ' rotated bilaplacian' 217 IF( nldf == 4 ) WRITE(numout,*) ' laplacian and bilaplacian operators' 218 IF( nldf == 5 ) WRITE(numout,*) ' rotated laplacian and bilaplacian operators' 185 219 ENDIF 186 220 ! -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r1156 r2236 38 38 !! OPA 9.0 , LOCEAN-IPSL (2005) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)40 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 41 41 !!---------------------------------------------------------------------- 42 42 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynnxt.F90
r2148 r2236 15 15 !! 2.3 ! 2007-07 (D. Storkey) Calls to BDY routines. 16 16 !! 3.2 ! 2009-06 (G. Madec, R.Benshila) re-introduce the vvl option 17 !! 3.3 ! 2010-09 (D. Storkey, E.O'Dea) Bug fix for BDY module 17 18 !!------------------------------------------------------------------------- 18 19 … … 34 35 USE bdydta ! unstructured open boundary conditions 35 36 USE bdydyn ! unstructured open boundary conditions 36 USE agrif_opa_update37 USE agrif_opa_interp38 37 USE in_out_manager ! I/O manager 39 38 USE lbclnk ! lateral boundary condition (or mpp link) 40 39 USE prtctl ! Print control 40 #if defined key_agrif 41 USE agrif_opa_update 42 USE agrif_opa_interp 43 #endif 41 44 42 45 IMPLICIT NONE … … 50 53 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 51 54 !! $Id$ 52 !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)55 !! Software is governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 53 56 !!------------------------------------------------------------------------- 54 57 … … 171 174 # elif defined key_bdy 172 175 ! !* BDY open boundaries 173 !RB all this part should be in a specific routine174 176 IF( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN ! except for filtered option 175 !176 177 CALL bdy_dyn_frs( kt ) 177 !178 IF( ln_bdy_dyn_fla ) THEN179 ua_e(:,:) = 0.e0180 va_e(:,:) = 0.e0181 ! Set these variables for use in bdy_dyn_fla182 hur_e(:,:) = hur(:,:)183 hvr_e(:,:) = hvr(:,:)184 DO jk = 1, jpkm1 !! Vertically integrated momentum trends185 ua_e(:,:) = ua_e(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk)186 va_e(:,:) = va_e(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk)187 END DO188 ua_e(:,:) = ua_e(:,:) * hur(:,:)189 va_e(:,:) = va_e(:,:) * hvr(:,:)190 DO jk = 1 , jpkm1191 ua(:,:,jk) = ua(:,:,jk) - ua_e(:,:)192 va(:,:,jk) = va(:,:,jk) - va_e(:,:)193 END DO194 CALL bdy_dta_bt( kt+1, 0)195 CALL bdy_dyn_fla( sshn_b )196 CALL lbc_lnk( ua_e, 'U', -1. ) ! Boundary points should be updated197 CALL lbc_lnk( va_e, 'V', -1. ) !198 DO jk = 1 , jpkm1199 ua(:,:,jk) = ( ua(:,:,jk) + ua_e(:,:) ) * umask(:,:,jk)200 va(:,:,jk) = ( va(:,:,jk) + va_e(:,:) ) * vmask(:,:,jk)201 END DO202 ENDIF203 !204 178 ENDIF 205 179 # endif -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg.F90
- Property svn:executable deleted
r2027 r2236 38 38 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)40 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 41 41 !!---------------------------------------------------------------------- 42 42 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_exp.F90
- Property svn:executable deleted
r1505 r2236 40 40 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 41 41 !! $Id$ 42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)42 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- 44 44 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_flt.F90
- Property svn:executable deleted
r2000 r2236 44 44 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 45 45 USE prtctl ! Print control 46 USE agrif_opa_interp47 46 USE iom 48 47 USE restart ! only for lrst_oce 49 48 USE lib_fortran 49 #if defined key_agrif 50 USE agrif_opa_interp 51 #endif 50 52 51 53 IMPLICIT NONE … … 61 63 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 62 64 !! $Id$ 63 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)65 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 64 66 !!---------------------------------------------------------------------- 65 67 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_oce.F90
r1566 r2236 44 44 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 45 45 !! $Id$ 46 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)46 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 47 47 !!====================================================================== 48 48 END MODULE dynspg_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_ts.F90
- Property svn:executable deleted
r2200 r2236 7 7 !! - ! 2008-01 (R. Benshila) change averaging method 8 8 !! 3.2 ! 2009-07 (R. Benshila, G. Madec) Complete revisit associated to vvl reactivation 9 !! 3.3 ! 2010-09 (D. Storkey, E. O'Dea) update for BDY for Shelf configurations 9 10 !!--------------------------------------------------------------------- 10 11 #if defined key_dynspg_ts || defined key_esopa … … 58 59 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 59 60 !! $Id$ 60 !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)61 !! Software is governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 61 62 !!------------------------------------------------------------------------- 62 63 … … 352 353 ! ! ------------------ 353 354 IF( lk_obc ) CALL obc_dta_bt( kt, jn ) 354 IF( lk_bdy .OR. ln_bdy_tides ) CALL bdy_dta_bt( kt, jn+1 )355 IF( lk_bdy .OR. ln_bdy_tides ) CALL bdy_dta_bt( kt, jn+1, icycle ) 355 356 356 357 ! !* after ssh_e -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynvor.F90
r2104 r2236 57 57 !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 58 58 !! $Id$ 59 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)59 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 60 60 !!---------------------------------------------------------------------- 61 61 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzad.F90
r1146 r2236 33 33 !! OPA 9.0 , LOCEAN-IPSL (2005) 34 34 !! $Id$ 35 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)35 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- 37 37 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzdf.F90
r2104 r2236 41 41 !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 42 42 !! $Id$ 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)43 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- 45 45 … … 104 104 USE zdftke_old 105 105 USE zdftke 106 USE zdfgls 106 107 USE zdfkpp 107 108 !!---------------------------------------------------------------------- … … 113 114 ! 114 115 ! Force implicit schemes 115 IF( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdf kpp ) nzdf = 1 ! TKEor KPP physics116 IF( ln_dynldf_iso ) nzdf = 1 ! iso-neutral lateral physics117 IF( ln_dynldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate116 IF( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) nzdf = 1 ! TKE, GLS or KPP physics 117 IF( ln_dynldf_iso ) nzdf = 1 ! iso-neutral lateral physics 118 IF( ln_dynldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 118 119 ! 119 120 IF( lk_esopa ) nzdf = -1 ! Esopa key: All schemes used -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
r2148 r2236 32 32 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 33 33 !! $Id$ 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)34 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 35 35 !!---------------------------------------------------------------------- 36 36 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r2148 r2236 20 20 USE phycst ! physical constants 21 21 USE in_out_manager ! I/O manager 22 #if defined key_zdfgls 23 USE zdfbfr, ONLY : bfrua, bfrva, wbotu, wbotv ! bottom stresses 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 #endif 22 26 23 27 IMPLICIT NONE … … 65 69 REAL(wp) :: zzwi, zzws, zrhs ! temporary scalars 66 70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi ! 3D workspace 71 #if defined key_zdfgls 72 INTEGER :: ikbu, ikbv, ikbum1, ikbvm1 73 REAL(wp) :: zcbcu, zcbcv 74 #endif 67 75 !!---------------------------------------------------------------------- 68 76 … … 155 163 END DO 156 164 END DO 157 ! 158 DO jk = 1, jpkm1 !== Normalization to obtain the general momentum trend ua == 165 166 #if defined key_zdfgls 167 ! Save bottom stress for next time step 168 DO jj = 2, jpjm1 169 DO ji = fs_2, fs_jpim1 ! vector opt. 170 ikbu = MIN( mbathy(ji+1,jj ), mbathy(ji,jj) ) 171 ikbum1 = MAX( ikbu-1, 1 ) 172 wbotu(ji,jj) = bfrua(ji,jj) * ua(ji,jj,ikbum1) * umask(ji,jj,ikbum1) 173 END DO 174 END DO 175 CALL lbc_lnk( wbotu(:,:), 'U', -1. ) 176 #endif 177 178 ! Normalization to obtain the general momentum trend ua 179 DO jk = 1, jpkm1 159 180 DO jj = 2, jpjm1 160 181 DO ji = fs_2, fs_jpim1 ! vector opt. … … 243 264 END DO 244 265 END DO 245 ! 246 DO jk = 1, jpkm1 !== Normalization to obtain the general momentum trend va == 266 267 #if defined key_zdfgls 268 ! Save bottom stress for next time step 269 DO jj = 2, jpjm1 270 DO ji = fs_2, fs_jpim1 ! vector opt. 271 ikbv = MIN( mbathy(ji,jj+1), mbathy(ji,jj) ) 272 ikbvm1 = MAX( ikbv-1, 1 ) 273 wbotv(ji,jj) = bfrva(ji,jj) * va(ji,jj,ikbvm1) * vmask(ji,jj,ikbvm1) 274 END DO 275 END DO 276 CALL lbc_lnk( wbotv(:,:), 'V', -1. ) 277 #endif 278 279 ! Normalization to obtain the general momentum trend va 280 DO jk = 1, jpkm1 247 281 DO jj = 2, jpjm1 248 282 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/sshwzv.F90
r2148 r2236 6 6 !! History : 3.1 ! 2009-02 (G. Madec, M. Leclair) Original code 7 7 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) modified LF-RA 8 !! - ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 9 !! - ! 2010-09 (D.Storkey and E.O'Dea) bug fixes for BDY module 8 10 !!---------------------------------------------------------------------- 9 11 … … 26 28 USE obc_par ! open boundary cond. parameter 27 29 USE obc_oce 30 USE bdy_oce 28 31 USE diaar5, ONLY : lk_diaar5 29 32 USE iom 30 USE sbcrnf, ONLY : rnf_dep, rnf_mod_dep ! River runoff 33 USE sbcrnf, ONLY : h_rnf, nk_rnf ! River runoff 34 #if defined key_asminc 35 USE asminc ! Assimilation increment 36 #endif 31 37 32 38 IMPLICIT NONE … … 42 48 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 43 49 !! $Id$ 44 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)50 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 45 51 !!---------------------------------------------------------------------- 46 52 … … 138 144 hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1.e0 - umask(:,:,1) ) 139 145 hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) 140 ! 146 ! 141 147 ENDIF 142 148 ! … … 168 174 ENDIF 169 175 #endif 176 #if defined key_bdy 177 ssha(:,:) = ssha(:,:) * bdytmask(:,:) 178 CALL lbc_lnk( ssha, 'T', 1. ) 179 #endif 180 170 181 ! ! Sea Surface Height at u-,v- and f-points (vvl case only) 171 182 IF( lk_vvl ) THEN ! (required only in key_vvl case) … … 184 195 CALL lbc_lnk( sshv_a, 'V', 1. ) 185 196 ENDIF 197 ! Include the IAU weighted SSH increment 198 #if defined key_asminc 199 IF( ( lk_asminc ).AND.( ln_sshinc ).AND.( ln_asmiau ) ) THEN 200 CALL ssh_asm_inc( kt ) 201 ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 202 ENDIF 203 #endif 204 186 205 ! !------------------------------! 187 206 ! ! Now Vertical Velocity ! … … 193 212 & - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) & 194 213 & * tmask(:,:,jk) * z1_2dt 214 #if defined key_bdy 215 wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 216 #endif 195 217 END DO 196 218 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/FLO/flo_oce.F90
r1601 r2236 51 51 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 52 52 !! $Id$ 53 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)53 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 54 54 !!====================================================================== 55 55 END MODULE flo_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/FLO/floats.F90
r2104 r2236 30 30 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 31 31 !! $Id$ 32 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)32 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 33 33 !!---------------------------------------------------------------------- 34 34 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/FLO/flowri.F90
r1715 r2236 34 34 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 35 35 !! $Id$ 36 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)36 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 37 37 !!---------------------------------------------------------------------- 38 38 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/in_out_manager.F90
r1976 r2236 110 110 !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 111 111 !! $Id$ 112 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)112 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 113 113 !!---------------------------------------------------------------------- 114 114 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom.F90
r1953 r2236 70 70 !! OPA 9.0 , LOCEAN-IPSL (2006) 71 71 !! $Id$ 72 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)72 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 73 73 !!---------------------------------------------------------------------- 74 74 … … 800 800 IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN 801 801 IF( iom_file(kiomid)%luld(idvar) ) THEN 802 IF( iom_file(kiomid)%dimsz(1,idvar) == size(ptime) ) THEN802 IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN 803 803 SELECT CASE (iom_file(kiomid)%iolib) 804 804 CASE (jpioipsl ) ; CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar ) -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_def.F90
r1359 r2236 10 10 !! OPA 9.0 , LOCEAN-IPSL (2006) 11 11 !! $Id$ 12 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)12 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 13 13 !!--------------------------------------------------------------------------------- 14 14 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_ioipsl.F90
r2200 r2236 37 37 !! OPA 9.0 , LOCEAN-IPSL (2006) 38 38 !! $Id$ 39 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)39 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 40 40 !!---------------------------------------------------------------------- 41 41 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_nf90.F90
r2200 r2236 38 38 !! OPA 9.0 , LOCEAN-IPSL (2006) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)40 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 41 41 !!---------------------------------------------------------------------- 42 42 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_rstdimg.F90
r1488 r2236 37 37 !! OPA 9.0 , LOCEAN-IPSL (2006) 38 38 !! $Id$ 39 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)39 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 40 40 !!---------------------------------------------------------------------- 41 41 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/restart.F90
r2148 r2236 21 21 USE in_out_manager ! I/O manager 22 22 USE iom ! I/O module 23 USE c1d ! re-initialization of u-v mask for the 1D configuration24 23 USE zpshde ! partial step: hor. derivative (zps_hde routine) 25 24 USE eosbn2 ! equation of state (eos bn2 routine) … … 29 28 USE domvvl ! variable volume 30 29 USE traswp ! swap from 4D T-S to 3D T & S and vice versa 30 #if defined key_zdfgls 31 USE zdfbfr, ONLY : wbotu, wbotv ! bottom stresses 32 USE zdf_oce 33 #endif 31 34 32 35 IMPLICIT NONE … … 46 49 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 47 50 !! $Id$ 48 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)51 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 49 52 !!---------------------------------------------------------------------- 50 53 … … 142 145 #endif 143 146 147 #if defined key_zdfgls 148 ! Save bottom stresses 149 CALL iom_rstput( kt, nitrst, numrow, 'wbotu' , wbotu ) 150 CALL iom_rstput( kt, nitrst, numrow, 'wbotv' , wbotv ) 151 #endif 152 144 153 IF( kt == nitrst ) THEN 145 154 CALL iom_close( numrow ) ! close the restart file (only at last time step) -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn.F90
- Property svn:executable deleted
r1954 r2236 38 38 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)40 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 41 41 !!---------------------------------------------------------------------- 42 42 … … 67 67 NAMELIST/namdyn_ldf/ ln_dynldf_lap , ln_dynldf_bilap, & 68 68 & ln_dynldf_level, ln_dynldf_hor , ln_dynldf_iso, & 69 & rn_ahm_0 69 & rn_ahm_0_lap , rn_ahmb_0 , rn_ahm_0_blp 70 70 !!---------------------------------------------------------------------- 71 71 … … 83 83 WRITE(numout,*) ' horizontal (geopotential) ln_dynldf_hor = ', ln_dynldf_hor 84 84 WRITE(numout,*) ' iso-neutral ln_dynldf_iso = ', ln_dynldf_iso 85 WRITE(numout,*) ' horizontal laplacian eddy viscosity rn_ahm_0 = ', rn_ahm_085 WRITE(numout,*) ' horizontal laplacian eddy viscosity rn_ahm_0_lap = ', rn_ahm_0_lap 86 86 WRITE(numout,*) ' background viscosity rn_ahmb_0 = ', rn_ahmb_0 87 WRITE(numout,*) ' horizontal bilaplacian eddy viscosity rn_ahm_0 = ', rn_ahm_0 88 89 ENDIF 90 91 ahm0 = rn_ahm_0 ! OLD namelist variables defined from DOCTOR namelist variables 87 WRITE(numout,*) ' horizontal bilaplacian eddy viscosity rn_ahm_0_blp = ', rn_ahm_0_blp 88 ENDIF 89 90 ahm0 = rn_ahm_0_lap ! OLD namelist variables defined from DOCTOR namelist variables 92 91 ahmb0 = rn_ahmb_0 93 92 ahm0_blp = rn_ahm_0_blp … … 120 119 IF( ln_dynldf_bilap ) THEN 121 120 IF(lwp) WRITE(numout,*) ' biharmonic momentum diffusion' 122 IF( ahm0_blp == 0.0 ) ahm0_blp = ahm0 ! Old namelist method: bilap specified with ahm0123 121 IF( .NOT. ln_dynldf_lap ) ahm0 = ahm0_blp ! Allow spatially varying coefs, which use ahm0 as input 124 122 IF( ahm0_blp > 0 .AND. .NOT. lk_esopa ) CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' ) -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90
r2200 r2236 29 29 !! * Local variables 30 30 INTEGER :: jk ! dummy loop indice 31 REAL(wp) :: 31 REAL(wp) :: zdam, zwam, zm00, zm01, zmhf, zmhs 32 32 REAL(wp) :: zdam2, zwam2, zm200, zm201, zmh2f, zmh2s 33 33 REAL(wp) :: zahmf, zahms -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90
- Property svn:executable deleted
-
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
- Property svn:executable deleted
-
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90
r1954 r2236 17 17 LOGICAL , PUBLIC :: ln_dynldf_hor = .TRUE. !: horizontal (geopotential) direction 18 18 LOGICAL , PUBLIC :: ln_dynldf_iso = .FALSE. !: iso-neutral direction 19 REAL(wp), PUBLIC :: rn_ahm_0 19 REAL(wp), PUBLIC :: rn_ahm_0_lap = 40000._wp !: lateral laplacian eddy viscosity (m2/s) 20 20 REAL(wp), PUBLIC :: rn_ahmb_0 = 0._wp !: lateral laplacian background eddy viscosity (m2/s) 21 21 REAL(wp), PUBLIC :: rn_ahm_0_blp = 0._wp !: lateral bilaplacian eddy viscosity (m4/s) 22 23 REAL(wp), PUBLIC :: ahm0, ahmb0, ahm0_blp ! OLD namelist names 22 REAL(wp), PUBLIC :: ahm0, ahmb0, ahm0_blp ! OLD namelist names 24 23 25 24 #if defined key_dynldf_c3d … … 36 35 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 37 36 !! $Id$ 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)37 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 39 38 !!====================================================================== 40 39 END MODULE ldfdyn_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfslp.F90
r2104 r2236 24 24 USE phycst ! physical constants 25 25 USE zdfmxl ! mixed layer depth 26 USE eosbn2 26 27 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 28 USE in_out_manager ! I/O manager … … 33 34 PUBLIC ldf_slp ! routine called by step.F90 34 35 PUBLIC ldf_slp_init ! routine called by opa.F90 36 PUBLIC ldf_slp_grif ! " 35 37 36 38 LOGICAL , PUBLIC, PARAMETER :: lk_ldfslp = .TRUE. !: slopes flag 37 39 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: uslp, wslpi !: i_slope at U- and W-points 38 40 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: vslp, wslpj !: j-slope at V- and W-points 41 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: wslp2 !: wslp**2 from Griffies quarter cells 42 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: alpha, beta !: alpha,beta at T points 43 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: tfw,sfw,ftu,fsu,ftv,fsv,ftud,fsud,ftvd,fsvd 44 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: psix_eiv 45 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: psiy_eiv 39 46 40 47 REAL(wp), DIMENSION(jpi,jpj,jpk) :: omlmask ! mask of the surface mixed layer at T-pt … … 44 51 !! * Substitutions 45 52 # include "domzgr_substitute.h90" 53 # include "ldftra_substitute.h90" 54 # include "ldfeiv_substitute.h90" 46 55 # include "vectopt_loop_substitute.h90" 47 56 !!---------------------------------------------------------------------- 48 57 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 49 58 !! $Id$ 50 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)59 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 51 60 !!---------------------------------------------------------------------- 52 61 … … 304 313 END DO 305 314 306 307 315 ! III. Specific grid points 308 316 ! =========================== … … 339 347 ! 340 348 END SUBROUTINE ldf_slp 349 350 SUBROUTINE ldf_slp_grif ( kt ) 351 !!---------------------------------------------------------------------- 352 !! *** ROUTINE ldf_slp_grif *** 353 !! 354 !! ** Purpose : Compute the squared slopes of neutral surfaces (slope 355 !! of iso-pycnal surfaces referenced locally) ('key_traldfiso') 356 !! at W-points using the Griffies quarter-cells. Also calculates 357 !! alpha and beta at T-points for use in the Griffies isopycnal 358 !! scheme. 359 !! 360 !! ** Method : The slope in the i-direction is computed at U- and 361 !! W-points (uslp, wslpi) and the slope in the j-direction is 362 !! computed at V- and W-points (vslp, wslpj). 363 !! 364 !! ** Action : - alpha, beta 365 !! wslp2 squared slope of neutral surfaces at w-points. 366 !! 367 !! History : 368 !! 9.0 ! 06-10 (C. Harris) New subroutine 369 !!---------------------------------------------------------------------- 370 !! * Modules used 371 USE oce , zdit => ua, & ! use ua as workspace 372 zdis => va, & ! use va as workspace 373 zdjt => ta, & ! use ta as workspace 374 zdjs => sa ! use sa as workspace 375 !! * Arguments 376 INTEGER, INTENT( in ) :: kt ! ocean time-step index 377 378 !! * Local declarations 379 INTEGER :: ji, jj, jk, ip, jp, kp ! dummy loop indices 380 INTEGER :: iku, ikv ! temporary integer 381 REAL(wp) :: & 382 zt, zs, zh, zt2, zsp5, zp1t1, & ! temporary scalars 383 zdenr, zrhotmp, zdndt, zdddt, & ! " " 384 zdnds, zddds, znum, zden, & ! " " 385 zslope, za_sxe, zslopec, zdsloper,& ! " " 386 zfact, zepsln, zatempw,zatempu,zatempv, & ! " " 387 ze1ur,ze2vr,ze3wr,zdxt,zdxs,zdyt,zdys,zdzt,zdzs,zvolf,& 388 zr_slpmax,zdxrho,zdyrho,zabs_dzrho 389 REAL(wp), DIMENSION(jpi,jpj,jpk,0:1,0:1) :: & 390 zsx,zsy 391 REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) :: & 392 zsx_ml_base,zsy_ml_base 393 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 394 zdkt,zdks 395 REAL(wp), DIMENSION(jpi,jpj) :: & 396 zr_ml_basew 397 !!---------------------------------------------------------------------- 398 399 ! 0. Local constant initialization 400 ! -------------------------------- 401 zr_slpmax = 1.0_wp/slpmax 402 403 ! zslopec=0.004 404 ! zdsloper=1000.0 405 zepsln=1e-25 406 407 SELECT CASE ( nn_eos ) 408 409 CASE ( 0 ) ! Jackett and McDougall (1994) formulation 410 411 ! ! =============== 412 DO jk = 1, jpk ! Horizontal slab 413 ! ! =============== 414 DO jj = 1, jpjm1 415 DO ji = 1, fs_jpim1 416 zt = tb(ji,jj,jk) ! potential temperature 417 zs = sb(ji,jj,jk) - 35.0 ! salinity anomaly (s-35) 418 zh = fsdept(ji,jj,jk) ! depth in meters 419 420 beta(ji,jj,jk) = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt & 421 & - 0.301985e-05 ) * zt & 422 & + 0.785567e-03 & 423 & + ( 0.515032e-08 * zs & 424 & + 0.788212e-08 * zt - 0.356603e-06 ) * zs & 425 & +( ( 0.121551e-17 * zh & 426 & - 0.602281e-15 * zs & 427 & - 0.175379e-14 * zt + 0.176621e-12 ) * zh & 428 & + 0.408195e-10 * zs & 429 & + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt & 430 & - 0.121555e-07 ) * zh 431 432 alpha(ji,jj,jk) = - beta(ji,jj,jk) * & 433 & (((( - 0.255019e-07 * zt + 0.298357e-05 ) * zt & 434 & - 0.203814e-03 ) * zt & 435 & + 0.170907e-01 ) * zt & 436 & + 0.665157e-01 & 437 & + ( - 0.678662e-05 * zs & 438 & - 0.846960e-04 * zt + 0.378110e-02 ) * zs & 439 & + ( ( - 0.302285e-13 * zh & 440 & - 0.251520e-11 * zs & 441 & + 0.512857e-12 * zt * zt ) * zh & 442 & - 0.164759e-06 * zs & 443 & +( 0.791325e-08 * zt - 0.933746e-06 ) * zt & 444 & + 0.380374e-04 ) * zh) 445 446 ENDDO 447 ENDDO 448 ENDDO 449 450 CASE ( 1 ) 451 452 alpha(:,:,:)=-rn_alpha 453 beta(:,:,:)=0.0 454 455 CASE ( 2 ) 456 457 alpha(:,:,:)=-rn_alpha 458 beta (:,:,:)=rn_beta 459 460 CASE ( 3 ) 461 462 DO jk =1, jpk 463 DO jj = 1, jpjm1 464 DO ji = 1, fs_jpim1 465 zt = tb(ji,jj,jk) 466 zs = sb(ji,jj,jk) 467 zh = fsdept(ji,jj,jk) 468 zt2 = zt**2 469 zsp5 = sqrt(ABS(zs)) 470 zp1t1=zh*zt 471 znum=9.99843699e+02+zt*(7.35212840e+00+zt*(-5.45928211e-02+3.98476704e-04*zt)) & 472 +zs*(2.96938239e+00-7.23268813e-03*zt+2.12382341e-03*zs) & 473 +zh*(1.04004591e-02+1.03970529e-07*zt2+5.18761880e-06*zs+ & 474 zh*(-3.24041825e-08-1.23869360e-11*zt2)) 475 zden=1.00000000e+00+zt*(7.28606739e-03+zt*(-4.60835542e-05+zt*(3.68390573e-07+zt*1.80809186e-10))) & 476 +zs*(2.14691708e-03+zt*(-9.27062484e-06-1.78343643e-10*zt2)+zsp5*(4.76534122e-06+1.63410736e-09*zt2)) & 477 + zh*(5.30848875e-06+zh*zt*(-3.03175128e-16*zt2-1.27934137e-17*zh)) 478 zdenr=1.0/zden 479 zrhotmp=znum*zdenr 480 zdndt=7.35212840e+00+zt*(-1.091856422e-01+1.195430112e-03*zt)-7.23268813e-03*zs & 481 +zp1t1*(2.07941058e-07-2.4773872e-11*zh) 482 zdddt=7.28606739e-03+zt*(-9.21671084e-05+zt*(1.105171719e-06+7.23236744e-10*zt)) & 483 +zs*(-9.27062484e-06+zt*(-5.35030929e-10*zt+3.26821472e-09*zsp5)) & 484 +zh*zh*(-9.09525384e-16*zt2-1.27934137e-17*zh) 485 zdnds=2.96938239e+00-7.23268813e-03*zt+2*2.12382341e-03*zs+5.18761880e-06*zh 486 zddds=2.14691708e-03+zt*(-9.27062484e-06-1.78343643e-10*zt2)+zsp5*(7.14801183e-06+2.45116104e-09*zt2) 487 alpha(ji,jj,jk)=(zdndt-zrhotmp*zdddt)*zdenr 488 beta(ji,jj,jk)=zdenr*(zdnds-zrhotmp*zddds) 489 490 END DO 491 END DO 492 END DO 493 494 CASE DEFAULT 495 496 IF(lwp) WRITE(numout,cform_err) 497 IF(lwp) WRITE(numout,*) ' bad flag value for nn_eos = ', nn_eos 498 nstop = nstop + 1 499 500 END SELECT 501 502 CALL lbc_lnk( alpha, 'T', 1. ) 503 CALL lbc_lnk( beta, 'T', 1. ) 504 505 506 ! --------------------------------------- 507 ! 1. Horizontal tracer gradients at T-level jk 508 ! --------------------------------------- 509 DO jk = 1, jpkm1 510 DO jj = 1, jpjm1 511 DO ji = 1, fs_jpim1 ! vector opt. 512 ! i-gradient of T and S at jj 513 zdit (ji,jj,jk) = ( tb(ji+1,jj,jk)-tb(ji,jj,jk) ) * umask(ji,jj,jk) 514 zdis (ji,jj,jk) = ( sb(ji+1,jj,jk)-sb(ji,jj,jk) ) * umask(ji,jj,jk) 515 ! j-gradient of T and S at jj 516 zdjt (ji,jj,jk) = ( tb(ji,jj+1,jk)-tb(ji,jj,jk) ) * vmask(ji,jj,jk) 517 zdjs (ji,jj,jk) = ( sb(ji,jj+1,jk)-sb(ji,jj,jk) ) * vmask(ji,jj,jk) 518 END DO 519 END DO 520 END DO 521 522 IF( ln_zps ) THEN ! partial steps correction at the last level 523 # if defined key_vectopt_loop && ! defined key_mpp_omp 524 jj = 1 525 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 526 # else 527 DO jj = 1, jpjm1 528 DO ji = 1, jpim1 529 # endif 530 ! last ocean level 531 iku = MIN( mbathy(ji,jj), mbathy(ji+1,jj ) ) - 1 532 ikv = MIN( mbathy(ji,jj), mbathy(ji ,jj+1) ) - 1 533 ! i-gradient of T and S 534 zdit (ji,jj,iku) = gtu(ji,jj) 535 zdis (ji,jj,iku) = gsu(ji,jj) 536 ! j-gradient of T and S 537 zdjt (ji,jj,ikv) = gtv(ji,jj) 538 zdjs (ji,jj,ikv) = gsv(ji,jj) 539 # if ! defined key_vectopt_loop || defined key_mpp_omp 540 END DO 541 # endif 542 END DO 543 ENDIF 544 545 ! --------------------------------------- 546 ! 1. Vertical tracer gradient at w-level jk 547 ! --------------------------------------- 548 DO jk = 2, jpk 549 zdkt(:,:,jk) = ( tb(:,:,jk-1) - tb(:,:,jk) ) * tmask(:,:,jk) 550 zdks(:,:,jk) = ( sb(:,:,jk-1) - sb(:,:,jk) ) * tmask(:,:,jk) 551 END DO 552 553 zdkt(:,:,1) = 0.0 554 zdks(:,:,1) = 0.0 555 556 ! --------------------------------------- 557 ! Depth of the w-point below ML base 558 ! --------------------------------------- 559 DO jj = 1, jpj 560 DO ji = 1, jpi 561 jk = nmln(ji,jj) 562 zr_ml_basew(ji,jj)=1.0/fsdepw(ji,jj,jk+1) 563 END DO 564 END DO 565 566 567 wslp2(:,:,:)=0.0 568 tfw(:,:,:) = 0.0 569 sfw(:,:,:) = 0.0 570 ftu(:,:,:) = 0.0 571 fsu(:,:,:) = 0.0 572 ftv(:,:,:) = 0.0 573 fsv(:,:,:) = 0.0 574 ftud(:,:,:) = 0.0 575 fsud(:,:,:) = 0.0 576 ftvd(:,:,:) = 0.0 577 fsvd(:,:,:) = 0.0 578 psix_eiv(:,:,:) = 0.0 579 psiy_eiv(:,:,:) = 0.0 580 581 ! ---------------------------------------------------------------------- 582 ! x-z plane 583 ! ---------------------------------------------------------------------- 584 585 ! calculate limited triad x-slopes zsx in interior (1=<jk=<jpk-1) 586 DO ip=0,1 587 DO kp=0,1 588 589 DO jk = 1, jpkm1 590 DO jj = 1, jpjm1 591 DO ji = 1, fs_jpim1 ! vector opt. 592 593 ze1ur=1.0/e1u(ji,jj) 594 zdxt=zdit(ji,jj,jk)*ze1ur 595 zdxs=zdis(ji,jj,jk)*ze1ur 596 597 ze3wr=1.0/fse3w(ji+ip,jj,jk+kp) 598 zdzt=zdkt(ji+ip,jj,jk+kp)*ze3wr 599 zdzs=zdks(ji+ip,jj,jk+kp)*ze3wr 600 ! Calculate the horizontal and vertical density gradient 601 zdxrho = alpha(ji+ip,jj,jk)*zdxt+beta(ji+ip,jj,jk)*zdxs 602 zabs_dzrho = ABS(alpha(ji+ip,jj,jk)*zdzt+beta(ji+ip,jj,jk)*zdzs)+zepsln 603 ! Limit by slpmax, and mask by psi-point 604 zsx(ji+ip,jj,jk,1-ip,kp) = umask(ji,jj,jk+kp) & 605 & *zdxrho/MAX(zabs_dzrho,zr_slpmax*ABS(zdxrho)) 606 END DO 607 END DO 608 END DO 609 610 END DO 611 END DO 612 613 ! calculate slope of triad immediately below mixed-layer base 614 DO ip=0,1 615 DO kp=0,1 616 DO jj = 1, jpjm1 617 DO ji = 1, fs_jpim1 618 jk = nmln(ji+ip,jj) 619 zsx_ml_base(ji+ip,jj,1-ip,kp)=zsx(ji+ip,jj,jk+1-kp,1-ip,kp) 620 END DO 621 END DO 622 END DO 623 END DO 624 625 ! Below ML use limited zsx as is 626 ! Inside ML replace by linearly reducing zsx_ml_base towards surface 627 DO ip=0,1 628 DO kp=0,1 629 630 DO jk = 1, jpkm1 631 632 DO jj = 1, jpjm1 633 634 DO ji = 1, fs_jpim1 ! vector opt. 635 ! k index of uppermost point(s) of triad is jk+kp-1 636 ! must be .ge. nmln(ji,jj) for zfact=1. 637 ! otherwise zfact=0. 638 zfact = 1 - 1/(1 + (jk+kp-1)/nmln(ji+ip,jj)) 639 zsx(ji+ip,jj,jk,1-ip,kp) = zfact*zsx(ji+ip,jj,jk,1-ip,kp) + & 640 & (1.0_wp-zfact)*(fsdepw(ji+ip,jj,jk+kp)*zr_ml_basew(ji+ip,jj))*zsx_ml_base(ji+ip,jj,1-ip,kp) 641 END DO 642 643 END DO 644 645 END DO 646 END DO 647 END DO 648 649 ! Use zsx to calculate fluxes and save averaged slopes psix_eiv at psi-points 650 DO ip=0,1 651 DO kp=0,1 652 653 DO jk = 1, jpkm1 654 655 DO jj = 1, jpjm1 656 657 DO ji = 1, fs_jpim1 ! vector opt. 658 659 ze1ur=1.0/e1u(ji,jj) 660 zdxt=zdit(ji,jj,jk)*ze1ur 661 zdxs=zdis(ji,jj,jk)*ze1ur 662 663 ze3wr=1.0/fse3w(ji+ip,jj,jk+kp) 664 zdzt=zdkt(ji+ip,jj,jk+kp)*ze3wr 665 zdzs=zdks(ji+ip,jj,jk+kp)*ze3wr 666 zslope=zsx(ji+ip,jj,jk,1-ip,kp) 667 668 zvolf = 0.25_wp*e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) 669 670 ftu(ji,jj,jk)= ftu(ji,jj,jk)+zslope*zdzt*zvolf*ze1ur 671 fsu(ji,jj,jk)= fsu(ji,jj,jk)+zslope*zdzs*zvolf*ze1ur 672 ftud(ji,jj,jk)=ftud(ji,jj,jk)+fsahtu(ji,jj,jk)*zdxt*zvolf*ze1ur 673 fsud(ji,jj,jk)=fsud(ji,jj,jk)+fsahtu(ji,jj,jk)*zdxs*zvolf*ze1ur 674 tfw(ji+ip,jj,jk+kp)=tfw(ji+ip,jj,jk+kp)+(zvolf*ze3wr)*zslope*zdxt 675 sfw(ji+ip,jj,jk+kp)=sfw(ji+ip,jj,jk+kp)+(zvolf*ze3wr)*zslope*zdxs 676 wslp2(ji+ip,jj,jk+kp)=wslp2(ji+ip,jj,jk+kp)+ & 677 & ((zvolf*ze3wr)/(e1t(ji+ip,jj)*e2t(ji+ip,jj)))*(zslope)**2 678 psix_eiv(ji,jj,jk+kp) = psix_eiv(ji,jj,jk+kp) + 0.25_wp*zslope 679 680 END DO 681 END DO 682 683 END DO 684 END DO 685 END DO 686 687 ! ---------------------------------------------------------------------- 688 ! y-z plane 689 ! ---------------------------------------------------------------------- 690 691 ! calculate limited triad y-slopes zsy in interior (1=<jk=<jpk-1) 692 DO jp=0,1 693 DO kp=0,1 694 695 DO jk = 1, jpkm1 696 DO jj = 1, jpjm1 697 DO ji = 1, fs_jpim1 ! vector opt. 698 699 ze2vr=1.0/e2v(ji,jj) 700 zdyt=zdjt(ji,jj,jk)*ze2vr 701 zdys=zdjs(ji,jj,jk)*ze2vr 702 703 ze3wr=1.0/fse3w(ji,jj+jp,jk+kp) 704 zdzt=zdkt(ji,jj+jp,jk+kp)*ze3wr 705 zdzs=zdks(ji,jj+jp,jk+kp)*ze3wr 706 ! Calculate the horizontal and vertical density gradient 707 zdyrho = alpha(ji,jj+jp,jk)*zdyt+beta(ji,jj+jp,jk)*zdys 708 zabs_dzrho = ABS(alpha(ji,jj+jp,jk)*zdzt+beta(ji,jj+jp,jk)*zdzs)+zepsln 709 ! Limit by slpmax, and mask by psi-point 710 zsy(ji,jj+jp,jk,1-jp,kp) = vmask(ji,jj,jk+kp) & 711 & *zdyrho/MAX(zabs_dzrho,zr_slpmax*ABS(zdyrho)) 712 END DO 713 END DO 714 END DO 715 716 END DO 717 END DO 718 719 ! calculate slope of triad immediately below mixed-layer base 720 DO jp=0,1 721 DO kp=0,1 722 DO jj = 1, jpjm1 723 DO ji = 1, fs_jpim1 724 jk = nmln(ji,jj+jp) 725 zsy_ml_base(ji,jj+jp,1-jp,kp)=zsy(ji,jj+jp,jk+1-kp,1-jp,kp) 726 END DO 727 END DO 728 END DO 729 END DO 730 731 ! Below ML use limited zsy as is 732 ! Inside ML replace by linearly reducing zsy_ml_base towards surface 733 DO jp=0,1 734 DO kp=0,1 735 736 DO jk = 1, jpkm1 737 738 DO jj = 1, jpjm1 739 740 DO ji = 1, fs_jpim1 ! vector opt. 741 ! k index of uppermost point(s) of triad is jk+kp-1 742 ! must be .ge. nmln(ji,jj) for zfact=1. 743 ! otherwise zfact=0. 744 zfact = 1 - 1/(1 + (jk+kp-1)/nmln(ji,jj+jp)) 745 zsy(ji,jj+jp,jk,1-jp,kp) = zfact*zsy(ji,jj+jp,jk,1-jp,kp) + & 746 & (1.0_wp-zfact)*(fsdepw(ji,jj+jp,jk+kp)*zr_ml_basew(ji,jj+jp))*zsy_ml_base(ji,jj+jp,1-jp,kp) 747 END DO 748 749 END DO 750 751 END DO 752 END DO 753 END DO 754 755 ! Use zsy to calculate fluxes and save averaged slopes psiy_eiv at psi-points 756 DO jp=0,1 757 DO kp=0,1 758 759 DO jk = 1, jpkm1 760 761 DO jj = 1, jpjm1 762 763 DO ji = 1, fs_jpim1 ! vector opt. 764 765 ze2vr=1.0/e2v(ji,jj) 766 zdyt=zdjt(ji,jj,jk)*ze2vr 767 zdys=zdjs(ji,jj,jk)*ze2vr 768 769 ze3wr=1.0/fse3w(ji,jj+jp,jk+kp) 770 zdzt=zdkt(ji,jj+jp,jk+kp)*ze3wr 771 zdzs=zdks(ji,jj+jp,jk+kp)*ze3wr 772 zslope=zsy(ji,jj+jp,jk,1-jp,kp) 773 774 zvolf = 0.25_wp*e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) 775 776 ftv(ji,jj,jk)= ftv(ji,jj,jk)+zslope*zdzt*zvolf*ze2vr 777 fsv(ji,jj,jk)= fsv(ji,jj,jk)+zslope*zdzs*zvolf*ze2vr 778 ftvd(ji,jj,jk)=ftvd(ji,jj,jk)+fsahtv(ji,jj,jk)*zdyt*zvolf*ze2vr 779 fsvd(ji,jj,jk)=fsvd(ji,jj,jk)+fsahtv(ji,jj,jk)*zdys*zvolf*ze2vr 780 tfw(ji,jj+jp,jk+kp)=tfw(ji,jj+jp,jk+kp)+(zvolf*ze3wr)*zslope*zdyt 781 sfw(ji,jj+jp,jk+kp)=sfw(ji,jj+jp,jk+kp)+(zvolf*ze3wr)*zslope*zdys 782 wslp2(ji,jj+jp,jk+kp)=wslp2(ji,jj+jp,jk+kp)+ & 783 & ((zvolf*ze3wr)/(e1t(ji,jj+jp)*e2t(ji,jj+jp)))*(zslope)**2 784 psiy_eiv(ji,jj,jk+kp) = psiy_eiv(ji,jj,jk+kp) + 0.25_wp*zslope 785 786 END DO 787 END DO 788 789 END DO 790 END DO 791 END DO 792 793 tfw(:,:,1)=0.0 794 sfw(:,:,1)=0.0 795 wslp2(:,:,1)=0.0 796 797 CALL lbc_lnk( wslp2, 'W', 1. ) 798 CALL lbc_lnk( tfw, 'W', 1. ) 799 CALL lbc_lnk( sfw, 'W', 1. ) 800 CALL lbc_lnk( ftu, 'U', -1. ) 801 CALL lbc_lnk( fsu, 'U', -1. ) 802 CALL lbc_lnk( ftv, 'V', -1. ) 803 CALL lbc_lnk( fsv, 'V', -1. ) 804 CALL lbc_lnk( ftud, 'U', -1. ) 805 CALL lbc_lnk( fsud, 'U', -1. ) 806 CALL lbc_lnk( ftvd, 'V', -1. ) 807 CALL lbc_lnk( fsvd, 'V', -1. ) 808 CALL lbc_lnk( psix_eiv, 'U', -1. ) 809 CALL lbc_lnk( psiy_eiv, 'V', -1. ) 810 811 812 END SUBROUTINE ldf_slp_grif 341 813 342 814 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldftra.F90
- Property svn:executable deleted
r1601 r2236 36 36 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 37 37 !! $Id$ 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)38 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 39 39 !!---------------------------------------------------------------------- 40 40 … … 67 67 NAMELIST/namtra_ldf/ ln_traldf_lap , ln_traldf_bilap, & 68 68 & ln_traldf_level, ln_traldf_hor , ln_traldf_iso, & 69 & rn_aht_0 , rn_ahtb_0 , rn_aeiv_0 69 & ln_traldf_grif , & 70 & rn_aht_0 , rn_ahtb_0 , rn_aeiv_0, & 71 & rn_slpmax 70 72 !!---------------------------------------------------------------------- 71 73 … … 83 85 WRITE(numout,*) ' laplacian operator ln_traldf_lap = ', ln_traldf_lap 84 86 WRITE(numout,*) ' bilaplacian operator ln_traldf_bilap = ', ln_traldf_bilap 87 WRITE(numout,*) ' griffies operator ln_traldf_grif = ', ln_traldf_grif 85 88 WRITE(numout,*) ' lateral eddy diffusivity rn_aht_0 = ', rn_aht_0 86 89 WRITE(numout,*) ' background hor. diffusivity rn_ahtb_0 = ', rn_ahtb_0 … … 89 92 ENDIF 90 93 94 slpmax = rn_slpmax 91 95 ! ! convert DOCTOR namelist names into OLD names 92 96 aht0 = rn_aht_0 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldftra_oce.F90
r1601 r2236 20 20 LOGICAL , PUBLIC :: ln_traldf_hor = .FALSE. !: horizontal (geopotential) direction 21 21 LOGICAL , PUBLIC :: ln_traldf_iso = .TRUE. !: iso-neutral direction 22 LOGICAL , PUBLIC :: ln_traldf_grif = .FALSE. !: griffies skew flux 22 23 REAL(wp), PUBLIC :: rn_aht_0 = 2000._wp !: lateral eddy diffusivity (m2/s) 23 24 REAL(wp), PUBLIC :: rn_ahtb_0 = 0._wp !: lateral background eddy diffusivity (m2/s) 24 25 REAL(wp), PUBLIC :: rn_aeiv_0 = 2000._wp !: eddy induced velocity coefficient (m2/s) 26 REAL(wp), PUBLIC :: rn_slpmax = 0.01_wp !: slope limit 25 27 26 28 REAL(wp), PUBLIC :: aht0, ahtb0, aeiv0 !!: OLD namelist names 29 REAL(wp), PUBLIC :: slpmax !: slope limit 27 30 28 31 #if defined key_traldf_c3d … … 41 44 !! 'key_traldf_eiv' eddy induced velocity 42 45 !!---------------------------------------------------------------------- 43 LOGICAL, PUBLIC, PARAMETER :: lk_traldf_eiv = .TRUE. !: eddy induced velocity flag46 LOGICAL, PUBLIC, PARAMETER :: lk_traldf_eiv = .TRUE. !: eddy induced velocity flag 44 47 45 48 # if defined key_traldf_c3d … … 67 70 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 68 71 !! $Id$ 69 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)72 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 70 73 !!===================================================================== 71 74 END MODULE ldftra_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBC/obc_oce.F90
r2200 r2236 233 233 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 234 234 !! $Id$ 235 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)235 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 236 236 !!====================================================================== 237 237 END MODULE obc_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/albedo.F90
r1601 r2236 47 47 !! NEMO/OPA 9.0 , LOCEAN-IPSL (2009) 48 48 !! $Id$ 49 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)49 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 50 50 !!---------------------------------------------------------------------- 51 51 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r2224 r2236 66 66 !! OPA 9.0 , LOCEAN-IPSL (2006) 67 67 !! $Header$ 68 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)68 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 69 69 !!---------------------------------------------------------------------- 70 70 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/cpl_oasis4.F90
r1715 r2236 120 120 !! OPA 9.0 , LOCEAN-IPSL (2006) 121 121 !! $Id$ 122 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)122 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 123 123 !!---------------------------------------------------------------------- 124 124 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/fldread.F90
r2004 r2236 15 15 USE oce ! ocean dynamics and tracers 16 16 USE dom_oce ! ocean space and time domain 17 USE ioipsl, ONLY : ymds2ju, ju2ymds ! for calendar 17 18 USE phycst ! ??? 18 19 USE in_out_manager ! I/O manager … … 29 30 LOGICAL :: ln_tint ! time interpolation or not (T/F) 30 31 LOGICAL :: ln_clim ! climatology or not (T/F) 31 CHARACTER(len = 7) :: cltype ! type of data file 'daily', 'monthly' or yearly'32 CHARACTER(len = 8) :: cltype ! type of data file 'daily', 'monthly' or yearly' 32 33 CHARACTER(len = 34) :: wname ! generic name of a NetCDF weights file to be used, blank if not 33 34 CHARACTER(len = 34) :: vcomp ! symbolic component name if a vector that needs rotation … … 43 44 LOGICAL :: ln_tint ! time interpolation or not (T/F) 44 45 LOGICAL :: ln_clim ! climatology or not (T/F) 45 CHARACTER(len = 7) :: cltype ! type of data file 'daily', 'monthly' or yearly'46 CHARACTER(len = 8) :: cltype ! type of data file 'daily', 'monthly' or yearly' 46 47 INTEGER :: num ! iom id of the jpfld files to be read 47 48 INTEGER :: nswap_sec ! swapping time in second since Jan. 1st 00h of nit000 year … … 78 79 INTEGER, DIMENSION(:,:,:), POINTER :: data_jpj ! array of source integers 79 80 REAL(wp), DIMENSION(:,:,:), POINTER :: data_wgt ! array of weights on model grid 80 REAL(wp), DIMENSION(:,: ), POINTER :: fly_dta ! array of values on input grid81 REAL(wp), DIMENSION(:,: ), POINTER :: col2 ! temporary array for reading in columns81 REAL(wp), DIMENSION(:,:,:), POINTER :: fly_dta ! array of values on input grid 82 REAL(wp), DIMENSION(:,:,:), POINTER :: col2 ! temporary array for reading in columns 82 83 END TYPE WGT 83 84 … … 93 94 !! OPA 9.0 , LOCEAN-IPSL (2006) 94 95 !! $Id$ 95 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)96 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 96 97 !!---------------------------------------------------------------------- 97 98 … … 159 160 160 161 ! last record to be read in the current file 161 IF( sd(jf)%nfreqh == -1 ) THEN ; ireclast = 12 162 IF( sd(jf)%nfreqh == -1 ) THEN 163 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 1 164 ELSE ; ireclast = 12 165 ENDIF 162 166 ELSE 163 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 164 ELSEIF( sd(jf)%cltype == 'daily' ) THEN ; ireclast = 24 / sd(jf)%nfreqh 165 ELSE ; ireclast = 24 * nyear_len( 1 ) / sd(jf)%nfreqh 167 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 168 ELSEIF( sd(jf)%cltype(1:4) == 'week' ) THEN ; ireclast = 24.* 7 / sd(jf)%nfreqh 169 ELSEIF( sd(jf)%cltype == 'daily' ) THEN ; ireclast = 24 / sd(jf)%nfreqh 170 ELSE ; ireclast = 24 * nyear_len( 1 ) / sd(jf)%nfreqh 166 171 ENDIF 167 172 ENDIF … … 207 212 IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 208 213 CALL wgt_list( sd(jf), kw ) 209 DO jk = 1, ipk 210 CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,jk,2), sd(jf)%nrec_a(1) ) 211 END DO 214 ipk = SIZE(sd(jf)%fnow,3) 215 IF( sd(jf)%ln_tint ) THEN 216 CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fdta(:,:,:,2) , sd(jf)%nrec_a(1) ) 217 ELSE 218 CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fnow(:,:,:) , sd(jf)%nrec_a(1) ) 219 ENDIF 212 220 ELSE 213 IF( ipk == 1 ) THEN 214 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 215 ELSE 216 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 217 ENDIF 221 SELECT CASE( SIZE(sd(jf)%fnow,3) ) 222 CASE(1) 223 IF( sd(jf)%ln_tint ) THEN 224 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 225 ELSE 226 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fnow(:,:,1) , sd(jf)%nrec_a(1) ) 227 ENDIF 228 CASE(jpk) 229 IF( sd(jf)%ln_tint ) THEN 230 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 231 ELSE 232 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fnow(:,:,:) , sd(jf)%nrec_a(1) ) 233 ENDIF 234 END SELECT 218 235 ENDIF 219 236 sd(jf)%rotn(2) = .FALSE. … … 249 266 IF( kf > 0 ) THEN 250 267 !! fields jf,kf are two components which need to be rotated together 251 DO nf = 1,2 268 IF( sd(jf)%ln_tint )THEN 269 DO nf = 1,2 270 !! check each time level of this pair 271 IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN 272 utmp(:,:) = 0.0 273 vtmp(:,:) = 0.0 274 ! 275 ipk = SIZE( sd(kf)%fnow(:,:,:) ,3 ) 276 DO jk = 1,ipk 277 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 278 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 279 sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 280 sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 281 ENDDO 282 ! 283 sd(jf)%rotn(nf) = .TRUE. 284 sd(kf)%rotn(nf) = .TRUE. 285 IF( lwp .AND. kt == nit000 ) & 286 WRITE(numout,*) 'fld_read: vector pair (', & 287 TRIM(sd(jf)%clvar),',',TRIM(sd(kf)%clvar), & 288 ') rotated on to model grid' 289 ENDIF 290 END DO 291 ELSE 252 292 !! check each time level of this pair 253 293 IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN … … 255 295 vtmp(:,:) = 0.0 256 296 ! 257 DO jk = 1, SIZE( sd(kf)%fdta, 3 ) 258 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 259 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 260 sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 261 sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 262 END DO 297 ipk = SIZE( sd(kf)%fnow(:,:,:) ,3 ) 298 DO jk = 1,ipk 299 CALL rot_rep( sd(jf)%fnow(:,:,jk),sd(kf)%fnow(:,:,jk),'T', 'en->i', utmp(:,:) ) 300 CALL rot_rep( sd(jf)%fnow(:,:,jk),sd(kf)%fnow(:,:,jk),'T', 'en->j', vtmp(:,:) ) 301 sd(jf)%fnow(:,:,jk) = utmp(:,:) 302 sd(kf)%fnow(:,:,jk) = vtmp(:,:) 303 ENDDO 263 304 ! 264 305 sd(jf)%rotn(nf) = .TRUE. … … 269 310 ') rotated on to model grid' 270 311 ENDIF 271 END DO312 ENDIF 272 313 ENDIF 273 314 ENDIF … … 301 342 ENDIF 302 343 !CDIR COLLAPSE 303 sd(jf)%fnow(:,:,:) = sd(jf)%fdta(:,:,:,2) ! piecewise constant field304 305 344 ENDIF 306 345 ! … … 326 365 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 327 366 !! 328 LOGICAL :: llprevyr ! are we reading previous year file? 329 LOGICAL :: llprevmth ! are we reading previous month file? 330 LOGICAL :: llprevday ! are we reading previous day file? 331 LOGICAL :: llprev ! llprevyr .OR. llprevmth .OR. llprevday 332 INTEGER :: idvar ! variable id 333 INTEGER :: inrec ! number of record existing for this variable 367 LOGICAL :: llprevyr ! are we reading previous year file? 368 LOGICAL :: llprevmth ! are we reading previous month file? 369 LOGICAL :: llprevweek ! are we reading previous week file? 370 LOGICAL :: llprevday ! are we reading previous day file? 371 LOGICAL :: llprev ! llprevyr .OR. llprevmth .OR. llprevday 372 INTEGER :: idvar ! variable id 373 INTEGER :: inrec ! number of record existing for this variable 334 374 INTEGER :: kwgt 335 INTEGER :: jk ! vertical loop variable 336 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 375 INTEGER :: jk !vertical loop variable 376 INTEGER :: ipk !number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 377 INTEGER :: iyear, imonth, iday ! first day of the current file in yyyy mm dd 378 INTEGER :: isec_week ! number of seconds since start of the weekly file 337 379 CHARACTER(LEN=1000) :: clfmt ! write format 338 380 !!--------------------------------------------------------------------- 339 381 340 382 ! some default definitions... 341 383 sdjf%num = 0 ! default definition for non-opened file 342 384 IF( sdjf%ln_clim ) sdjf%clname = TRIM( sdjf%clrootname ) ! file name defaut definition, never change in this case 343 llprevyr = .FALSE. 344 llprevmth = .FALSE. 345 llprevday = .FALSE. 385 llprevyr = .FALSE. 386 llprevmth = .FALSE. 387 llprevweek = .FALSE. 388 llprevday = .FALSE. 389 isec_week = 0 346 390 347 391 ! define record informations … … 365 409 llprevmth = .NOT. sdjf%ln_clim ! use previous month file? 366 410 llprevyr = llprevmth .AND. nmonth == 1 ! use previous year file? 411 ELSE IF ( sdjf%cltype(1:4) == 'week' ) THEN !weekly file 412 isec_week = 86400 * 7 413 sdjf%nrec_b(1) = 24. / sdjf%nfreqh * 7 ! last record of previous weekly file 367 414 ELSEIF( sdjf%cltype == 'daily' ) THEN ! daily file 368 415 sdjf%nrec_b(1) = 24 / sdjf%nfreqh ! last record of previous day … … 376 423 ENDIF 377 424 ENDIF 378 llprev = llprevyr .OR. llprevmth .OR. llprev day425 llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 379 426 380 427 CALL fld_clopn( sdjf, nyear - COUNT((/llprevyr /)) , & 381 428 & nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)), & 382 429 & nday - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev ) 383 430 431 IF ( sdjf%cltype(1:4) == 'week' ) THEN 432 isec_week = ksec_week( sdjf%cltype(6:8) ) 433 if(lwp)write(numout,*)'cbr test2 isec_week = ',isec_week 434 llprevmth = ( isec_week .GT. nsec_month ) 435 llprevyr = llprevmth .AND. nmonth==1 436 ENDIF 437 ! 438 iyear = nyear - COUNT((/llprevyr /)) 439 imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /)) 440 iday = nday - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - INT( isec_week )/86400 441 ! 442 CALL fld_clopn( sdjf , iyear , imonth , iday , .NOT. llprev ) 443 384 444 ! if previous year/month/day file does not exist, we switch to the current year/month/day 385 445 IF( llprev .AND. sdjf%num <= 0 ) THEN … … 399 459 400 460 ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 401 ipk = SIZE( sdjf%fdta, 3 )402 461 IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 403 462 CALL wgt_list( sdjf, kwgt ) 404 DO jk = 1, ipk 405 CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,jk,2), sdjf%nrec_b(1) ) 406 END DO 463 ipk = SIZE(sdjf%fnow,3) 464 IF( sdjf%ln_tint ) THEN 465 CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 466 ELSE 467 CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fnow(:,:,:) , sdjf%nrec_a(1) ) 468 ENDIF 407 469 ELSE 408 IF( ipk == 1 ) THEN 409 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 410 ELSE 411 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 412 ENDIF 470 SELECT CASE( SIZE(sdjf%fnow,3) ) 471 CASE(1) 472 IF( sdjf%ln_tint ) THEN 473 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 474 ELSE 475 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1) , sdjf%nrec_b(1) ) 476 ENDIF 477 CASE(jpk) 478 IF( sdjf%ln_tint ) THEN 479 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 480 ELSE 481 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,:) , sdjf%nrec_b(1) ) 482 ENDIF 483 END SELECT 413 484 ENDIF 414 485 sdjf%rotn(2) = .FALSE. … … 422 493 423 494 IF( sdjf%num <= 0 ) CALL fld_clopn( sdjf, nyear, nmonth, nday ) ! make sure current year/month/day file is opened 495 ! make sure current year/month/day file is opened 496 IF( sdjf%num == 0 ) THEN 497 isec_week = 0 498 llprevyr = .FALSE. 499 llprevmth = .FALSE. 500 llprevweek = .FALSE. 501 ! 502 IF ( sdjf%cltype(1:4) == 'week' ) THEN 503 isec_week = ksec_week( sdjf%cltype(6:8) ) 504 llprevmth = ( isec_week .GT. nsec_month ) 505 llprevyr = llprevmth .AND. nmonth==1 506 ENDIF 507 ! 508 iyear = nyear - COUNT((/llprevyr /)) 509 imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /)) 510 iday = nday + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week/86400 511 ! 512 CALL fld_clopn( sdjf, iyear, imonth, iday ) 513 ENDIF 424 514 425 515 sdjf%nswap_sec = nsec_year + nsec1jan000 - 1 ! force read/update the after data in the following part of fld_read 426 516 517 427 518 END SUBROUTINE fld_init 428 519 … … 442 533 REAL(wp) :: ztmp ! temporary variable 443 534 INTEGER :: ifreq_sec ! frequency mean (in seconds) 535 INTEGER :: isec_week ! number of seconds since the start of the weekly file 444 536 !!---------------------------------------------------------------------- 445 537 ! … … 458 550 ! forcing record : nmonth 459 551 ! 552 ztmp = 0.e0 460 553 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 461 554 ELSE … … 468 561 ENDIF 469 562 470 sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /) ! define after record number and time 471 irec = irec - 1 ! move back to previous record 472 sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /) ! define before record number and time 563 IF( sdjf%cltype == 'monthly' ) THEN 564 565 sdjf%nrec_b(:) = (/ 0, nmonth_half(irec - 1 ) + nsec1jan000 /) 566 sdjf%nrec_a(:) = (/ 1, nmonth_half(irec ) + nsec1jan000 /) 567 568 IF( ztmp == 1. ) THEN 569 sdjf%nrec_b(1) = 1 570 sdjf%nrec_a(1) = 2 571 ENDIF 572 573 ELSE 574 575 sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /) ! define after record number and time 576 irec = irec - 1 ! move back to previous record 577 sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /) ! define before record number and time 578 579 ENDIF 473 580 ! 474 581 ELSE ! higher frequency mean (in hours) 475 582 ! 476 583 ifreq_sec = sdjf%nfreqh * 3600 ! frequency mean (in seconds) 584 IF( sdjf%cltype(1:4) == 'week' ) isec_week = ksec_week( sdjf%cltype(6:8)) !since the first day of the current week 477 585 ! number of second since the beginning of the file 478 IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = REAL(nsec_month,wp) ! since 00h on the 1st day of the current month 479 ELSEIF( sdjf%cltype == 'daily' ) THEN ; ztmp = REAL(nsec_day ,wp) ! since 00h of the current day 480 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 586 IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = REAL(nsec_month ,wp) ! since 00h on the 1st day of the current month 587 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ; ztmp = REAL(isec_week ,wp) ! since the first day of the current week 588 ELSEIF( sdjf%cltype == 'daily' ) THEN ; ztmp = REAL(nsec_day ,wp) ! since 00h of the current day 589 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 481 590 ENDIF 482 591 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record … … 514 623 ! after record index and second since Jan. 1st 00h of nit000 year 515 624 sdjf%nrec_a(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 516 IF( sdjf%cltype == 'monthly' ) & ! add the number of seconds between 00h Jan 1 and the end of previous month625 IF( sdjf%cltype == 'monthly' ) & ! add the number of seconds between 00h Jan 1 and the end of previous month 517 626 sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * SUM(nmonth_len(1:nmonth -1)) ! ok if nmonth=1 518 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 627 IF( sdjf%cltype(1:4) == 'week' ) & ! add the number of seconds between 00h Jan 1 and the end of previous week 628 sdjf%nrec_a(2) = sdjf%nrec_a(2) + ( nsec_year - isec_week ) 629 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 519 630 sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * ( nday_year - 1 ) 520 631 … … 522 633 irec = irec - 1. ! move back to previous record 523 634 sdjf%nrec_b(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 524 IF( sdjf%cltype == 'monthly' ) & ! add the number of seconds between 00h Jan 1 and the end of previous month635 IF( sdjf%cltype == 'monthly' ) & ! add the number of seconds between 00h Jan 1 and the end of previous month 525 636 sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * SUM(nmonth_len(1:nmonth -1)) ! ok if nmonth=1 526 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 637 IF( sdjf%cltype(1:4) == 'week' ) & ! add the number of seconds between 00h Jan 1 and the end of previous week 638 sdjf%nrec_b(2) = sdjf%nrec_b(2) + ( nsec_year - isec_week ) 639 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 527 640 sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * ( nday_year - 1 ) 528 641 … … 545 658 !! ** Method : 546 659 !!---------------------------------------------------------------------- 547 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 548 INTEGER , INTENT(in ) :: kyear ! year value 549 INTEGER , INTENT(in ) :: kmonth ! month value 550 INTEGER , INTENT(in ) :: kday ! day value 551 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 660 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 661 INTEGER , INTENT(in ) :: kyear ! year value 662 INTEGER , INTENT(in ) :: kmonth ! month value 663 INTEGER , INTENT(in ) :: kday ! day value 664 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 665 INTEGER :: iyear, imonth, iday ! firt day of the current week in yyyy mm dd 666 REAL(wp) :: zsec, zjul !temp variable 552 667 553 668 IF( sdjf%num /= 0 ) CALL iom_close( sdjf%num ) ! close file if already open 554 669 ! build the new filename if not climatological data 555 IF( .NOT. sdjf%ln_clim ) THEN ; WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year 556 IF( sdjf%cltype /= 'yearly' ) WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth ! add month 557 IF( sdjf%cltype == 'daily' ) WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday ! add day 670 sdjf%clname=TRIM(sdjf%clrootname) 671 ! 672 IF( sdjf%cltype(1:4) == 'week' .AND. nn_leapy==0 )CALL ctl_stop( 'fld_clopn: weekly file and nn_leapy=0 are not compatible' ) 673 ! 674 IF( .NOT. sdjf%ln_clim ) THEN 675 WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year 676 IF( sdjf%cltype /= 'yearly' ) & 677 & WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth ! add month 678 IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 679 & WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday ! add day 680 ELSE 681 ! build the new filename if climatological data 682 IF( sdjf%cltype == 'monthly' ) WRITE(sdjf%clname, '(a,"_m" ,i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month 558 683 ELSE 559 684 ! build the new filename if climatological data … … 610 735 & ' pairing : ' , TRIM( sdf(jf)%vcomp ), & 611 736 & ' data type: ' , sdf(jf)%cltype 737 call flush(numout) 612 738 END DO 613 739 ENDIF … … 707 833 INTEGER :: inum ! temporary logical unit 708 834 INTEGER :: id ! temporary variable id 835 INTEGER :: ipk ! temporary vertical dimension 709 836 CHARACTER (len=5) :: aname 710 837 INTEGER , DIMENSION(3) :: ddims … … 869 996 ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration. 870 997 ! a more robust solution will be given in next release 871 ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3) ) 872 IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3) ) 998 ipk = SIZE(sd%fnow,3) 999 ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) ) 1000 IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) ) 873 1001 874 1002 nxt_wgt = nxt_wgt + 1 … … 880 1008 END SUBROUTINE fld_weight 881 1009 882 SUBROUTINE fld_interp(num, clvar, kw, dta, nrec)1010 SUBROUTINE fld_interp(num, clvar, kw, kk, dta, nrec) 883 1011 !!--------------------------------------------------------------------- 884 1012 !! *** ROUTINE fld_interp *** … … 892 1020 CHARACTER(LEN=*), INTENT(in) :: clvar ! variable name 893 1021 INTEGER, INTENT(in) :: kw ! weights number 894 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: dta ! output field on model grid 1022 INTEGER, INTENT(in) :: kk ! vertical dimension of kk 1023 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kk) :: dta ! output field on model grid 895 1024 INTEGER, INTENT(in) :: nrec ! record number to read (ie time slice) 896 1025 !! 897 INTEGER, DIMENSION( 2) :: rec1,recn ! temporary arrays for start and length1026 INTEGER, DIMENSION(3) :: rec1,recn ! temporary arrays for start and length 898 1027 INTEGER :: jk, jn, jm ! loop counters 899 1028 INTEGER :: ni, nj ! lengths … … 918 1047 rec1(1) = MAX( jpimin-1, 1 ) 919 1048 rec1(2) = MAX( jpjmin-1, 1 ) 1049 rec1(3) = 1 920 1050 recn(1) = MIN( jpiwid+2, ref_wgts(kw)%ddims(1)-rec1(1)+1 ) 921 1051 recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 ) 1052 recn(3) = kk 922 1053 923 1054 !! where we need to read it to … … 927 1058 jpj2 = jpj1 + recn(2) - 1 928 1059 929 ref_wgts(kw)%fly_dta(:,:) = 0.0 930 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2), nrec, rec1, recn) 1060 ref_wgts(kw)%fly_dta(:,:,:) = 0.0 1061 SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 1062 CASE(1) 1063 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 1064 CASE(jpk) 1065 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 1066 END SELECT 931 1067 932 1068 !! first four weights common to both bilinear and bicubic 933 1069 !! note that we have to offset by 1 into fly_dta array because of halo 934 dta(:,: ) = 0.01070 dta(:,:,:) = 0.0 935 1071 DO jk = 1,4 936 DO jn = 1, jpj937 DO jm = 1, jpi1072 DO jn = 1, nlcj 1073 DO jm = 1,nlci 938 1074 ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 939 1075 nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 940 dta(jm,jn ) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1)1076 dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1,jk) 941 1077 END DO 942 1078 END DO … … 947 1083 !! fix up halo points that we couldnt read from file 948 1084 IF( jpi1 == 2 ) THEN 949 ref_wgts(kw)%fly_dta(jpi1-1,: ) = ref_wgts(kw)%fly_dta(jpi1,:)1085 ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:) 950 1086 ENDIF 951 1087 IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 952 ref_wgts(kw)%fly_dta(jpi2+1,: ) = ref_wgts(kw)%fly_dta(jpi2,:)1088 ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:) 953 1089 ENDIF 954 1090 IF( jpj1 == 2 ) THEN 955 ref_wgts(kw)%fly_dta(:,jpj1-1 ) = ref_wgts(kw)%fly_dta(:,jpj1)1091 ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:) 956 1092 ENDIF 957 1093 IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN 958 ref_wgts(kw)%fly_dta(:,jpj2+1 ) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2) - ref_wgts(kw)%fly_dta(:,jpj2-1)1094 ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:) 959 1095 ENDIF 960 1096 … … 969 1105 IF( jpi1 == 2 ) THEN 970 1106 rec1(1) = ref_wgts(kw)%ddims(1) - 1 971 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 972 ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2) 1107 SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) ) 1108 CASE(1) 1109 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn) 1110 CASE(jpk) 1111 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn) 1112 END SELECT 1113 ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2,:) 973 1114 ENDIF 974 1115 IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 975 1116 rec1(1) = 1 976 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 977 ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2) 1117 SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) ) 1118 CASE(1) 1119 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn) 1120 CASE(jpk) 1121 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn) 1122 END SELECT 1123 ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2,:) 978 1124 ENDIF 979 1125 ENDIF … … 981 1127 ! gradient in the i direction 982 1128 DO jk = 1,4 983 DO jn = 1, jpj984 DO jm = 1, jpi1129 DO jn = 1, nlcj 1130 DO jm = 1,nlci 985 1131 ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 986 1132 nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 987 dta(jm,jn ) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 * &988 (ref_wgts(kw)%fly_dta(ni+2,nj+1 ) - ref_wgts(kw)%fly_dta(ni,nj+1))1133 dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 * & 1134 (ref_wgts(kw)%fly_dta(ni+2,nj+1,:) - ref_wgts(kw)%fly_dta(ni,nj+1,:)) 989 1135 END DO 990 1136 END DO … … 993 1139 ! gradient in the j direction 994 1140 DO jk = 1,4 995 DO jn = 1, jpj996 DO jm = 1, jpi1141 DO jn = 1, nlcj 1142 DO jm = 1,nlci 997 1143 ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 998 1144 nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 999 dta(jm,jn ) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 * &1000 (ref_wgts(kw)%fly_dta(ni+1,nj+2 ) - ref_wgts(kw)%fly_dta(ni+1,nj))1145 dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 * & 1146 (ref_wgts(kw)%fly_dta(ni+1,nj+2,:) - ref_wgts(kw)%fly_dta(ni+1,nj,:)) 1001 1147 END DO 1002 1148 END DO … … 1009 1155 ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 1010 1156 nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 1011 dta(jm,jn ) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( &1012 (ref_wgts(kw)%fly_dta(ni+2,nj+2 ) - ref_wgts(kw)%fly_dta(ni ,nj+2)) - &1013 (ref_wgts(kw)%fly_dta(ni+2,nj ) - ref_wgts(kw)%fly_dta(ni ,nj)))1157 dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 1158 (ref_wgts(kw)%fly_dta(ni+2,nj+2,:) - ref_wgts(kw)%fly_dta(ni ,nj+2,:)) - & 1159 (ref_wgts(kw)%fly_dta(ni+2,nj ,:) - ref_wgts(kw)%fly_dta(ni ,nj ,:))) 1014 1160 END DO 1015 1161 END DO … … 1019 1165 1020 1166 END SUBROUTINE fld_interp 1021 1167 1168 FUNCTION ksec_week( cdday ) 1169 !!--------------------------------------------------------------------- 1170 !! *** FUNCTION kshift_week *** 1171 !! 1172 !! ** Purpose : 1173 !! 1174 !! ** Method : 1175 !!--------------------------------------------------------------------- 1176 CHARACTER(len=*), INTENT(in) :: cdday !3 first letters of the first day of the weekly file 1177 !! 1178 INTEGER :: ksec_week ! output variable 1179 INTEGER :: ijul !temp variable 1180 INTEGER :: ishift !temp variable 1181 CHARACTER(len=3),DIMENSION(7) :: cl_week 1182 !!---------------------------------------------------------------------- 1183 cl_week = (/"sun","sat","fri","thu","wed","tue","mon"/) 1184 DO ijul=1,7 1185 IF( cl_week(ijul)==TRIM(cdday) ) EXIT 1186 ENDDO 1187 IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): ',TRIM(cdday) ) 1188 ! 1189 ishift = ( ijul ) * 86400 1190 ! 1191 ksec_week = nsec_week + ishift 1192 ksec_week = MOD( ksec_week , 86400*7 ) 1193 if(lwp)write(numout,*)'cbr ijul ksec_week ',ijul,ksec_week 1194 ! 1195 END FUNCTION ksec_week 1196 1022 1197 END MODULE fldread -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/geo2ocean.F90
r1970 r2236 27 27 ! they are only a useless overlay of rot_rep 28 28 29 PUBLIC obs_rot 30 29 31 REAL(wp), DIMENSION(jpi,jpj) :: & 30 32 gsint, gcost, & ! cos/sin between model grid lines and NP direction at T point … … 40 42 !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 41 43 !! $Id$ 42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)44 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 43 45 !!---------------------------------------------------------------------- 44 46 … … 522 524 END SUBROUTINE repere 523 525 526 527 SUBROUTINE obs_rot ( psinu, pcosu, psinv, pcosv ) 528 !!---------------------------------------------------------------------- 529 !! *** ROUTINE obs_rot *** 530 !! 531 !! ** Purpose : Copy gsinu, gcosu, gsinv and gsinv 532 !! to input data for rotations of 533 !! current at observation points 534 !! 535 !! History : 536 !! 9.2 ! 09-02 (K. Mogensen) 537 !!---------------------------------------------------------------------- 538 REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT ):: & 539 & psinu, pcosu, psinv, pcosv! copy of data 540 541 !!---------------------------------------------------------------------- 542 543 ! Initialization of gsin* and gcos* at first call 544 ! ----------------------------------------------- 545 546 IF( lmust_init ) THEN 547 IF(lwp) WRITE(numout,*) 548 IF(lwp) WRITE(numout,*) ' obs_rot : geographic <--> stretched' 549 IF(lwp) WRITE(numout,*) ' ~~~~~~~ coordinate transformation' 550 551 CALL angle ! initialization of the transformation 552 lmust_init = .FALSE. 553 554 ENDIF 555 556 psinu(:,:) = gsinu(:,:) 557 pcosu(:,:) = gcosu(:,:) 558 psinv(:,:) = gsinv(:,:) 559 pcosv(:,:) = gcosv(:,:) 560 561 END SUBROUTINE obs_rot 562 563 524 564 !!====================================================================== 525 565 END MODULE geo2ocean -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/oasis4_date.F90
r1156 r2236 12 12 !! OPA 9.0 , LOCEAN-IPSL (2006) 13 13 !! $Id$ 14 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)14 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 15 15 !!---------------------------------------------------------------------- 16 16 !##################### WARNING coupled mode ############################### -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbc_ice.F90
r1482 r2236 63 63 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 64 64 !! $Id$ 65 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)65 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 66 66 !!---------------------------------------------------------------------- 67 67 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbc_oce.F90
r2148 r2236 83 83 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 84 84 !! $Id$ 85 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)85 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 86 86 !!====================================================================== 87 87 END MODULE sbc_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcana.F90
r2200 r2236 41 41 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 42 42 !! $Id$ 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)43 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- 45 45 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r1951 r2236 83 83 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 84 84 !! $Id$ 85 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)85 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 86 86 !!---------------------------------------------------------------------- 87 87 … … 160 160 CALL ctl_stop( 'sbc_blk_clio: unable to allocate sf structure' ) ; RETURN 161 161 ENDIF 162 163 162 DO ifpr= 1, jpfld 164 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1 ) ) 165 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 166 END DO 167 168 163 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 164 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 165 END DO 169 166 ! fill sf with slf_i and control print 170 167 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_clio', 'flux formulation for ocean surface boundary condition', 'namsbc_clio' ) -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r2228 r2236 74 74 !! NEMO/OPA 3.3 , NEMO-consortium (2010) 75 75 !! $Id$ 76 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)76 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 77 77 !!---------------------------------------------------------------------- 78 78 CONTAINS … … 169 169 ENDIF 170 170 DO ifpr= 1, jfld 171 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1 172 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )171 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 172 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 173 173 END DO 174 174 ! ! fill sf with slf_i and control print … … 269 269 !CDIR COLLAPSE 270 270 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 271 272 271 ! ----------------------------------------------------------------------------- ! 273 272 ! II Turbulent FLUXES ! -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbccpl.F90
r2228 r2236 166 166 !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 167 167 !! $Id$ 168 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)168 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 169 169 !!---------------------------------------------------------------------- 170 170 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcflx.F90
r2228 r2236 42 42 !! NEMO/OPA 3.3 , NEMO-consortium (2010) 43 43 !! $Id$ 44 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)44 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 45 45 !!---------------------------------------------------------------------- 46 46 CONTAINS … … 115 115 ENDIF 116 116 DO ji= 1, jpfld 117 ALLOCATE( sf(ji)%fnow(jpi,jpj,1 118 ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )117 ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 118 IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) 119 119 END DO 120 120 ! ! fill sf with slf_i and control print -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcfwb.F90
r2000 r2236 43 43 !! OPA 9.0 , LOCEAN-IPSL (2006) 44 44 !! $Id$ 45 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)45 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 46 46 !!---------------------------------------------------------------------- 47 47 CONTAINS … … 66 66 INTEGER :: inum ! temporary logical unit 67 67 INTEGER :: ikty, iyear ! 68 REAL(wp) :: z_fwf, z_fwf_nsrf ! temporary scalars68 REAL(wp) :: z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp ! temporary scalars 69 69 REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread 70 70 REAL(wp), DIMENSION(jpi,jpj) :: ztmsk_neg, ztmsk_pos, ztmsk_tospread … … 161 161 ! fwf global mean 162 162 z_fwf = glob_sum( e1e2_i(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area 163 ! 163 IF( lk_mpp ) CALL mpp_sum( z_fwf ) 164 IF( lk_mpp ) CALL mpp_sum( zsurf_neg ) 165 IF( lk_mpp ) CALL mpp_sum( zsurf_pos ) 164 166 165 167 IF( z_fwf < 0.e0 ) THEN … … 174 176 175 177 ! fwf global mean over <0 or >0 erp area 176 z_fwf_nsrf = SUM( e1e2_i(:,:) * z_fwf ) / ( zsurf_tospread + rsmall ) 178 zsum_fwf = SUM( e1e2_i(:,:) * z_fwf ) 179 IF( lk_mpp ) CALL mpp_sum( zsum_fwf ) 180 z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall ) 177 181 ! weight to respect erp field 2D structure 182 !!gm Strange 178 183 z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( SUM( ztmsk_tospread(:,:) * erp(:,:) * e1e2_i(:,:) ) + rsmall ) 179 184 ! final correction term to apply -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcice_if.F90
r1951 r2236 32 32 !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 33 33 !! $Id$ 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)34 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 35 35 !!---------------------------------------------------------------------- 36 36 … … 81 81 CALL ctl_stop( 'sbc_ice_if: unable to allocate sf_ice structure' ) ; RETURN 82 82 ENDIF 83 ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1 84 ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) )83 ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1) ) 84 IF( sn_ice%ln_tint ) ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) ) 85 85 86 86 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r1715 r2236 19 19 !!---------------------------------------------------------------------- 20 20 USE oce ! ocean dynamics and tracers 21 USE c1d ! 1d configuration22 21 USE dom_oce ! ocean space and time domain 23 22 USE lib_mpp … … 65 64 !! NEMO/LIM 3.0 , UCL-LOCEAN-IPSL (2008) 66 65 !! $Id$ 67 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)66 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 68 67 !!---------------------------------------------------------------------- 69 68 … … 196 195 IF( ln_nicep ) CALL lim_prt_state( jiindx, jjindx, 1, ' - Beginning the time step - ' ) ! control print 197 196 ! 198 IF( .NOT. lk_c1d ) THEN ! Ice dynamics & transport (not in 1D case) 197 #if ! defined key_c1d 198 ! Ice dynamics & transport (not in 1D case) 199 199 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 200 200 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) … … 203 203 IF( ln_nicep ) CALL lim_prt_state( jiindx, jjindx,-1, ' - ice dyn & trp - ' ) ! control print 204 204 CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 205 ENDIF 205 #endif 206 206 ! 207 207 ! ! Ice thermodynamics -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r2224 r2236 8 8 !! History : 1.0 ! 06-2006 (G. Madec) from icestp_2.F90 9 9 !! 3.0 ! 08-2008 (S. Masson, E. .... ) coupled interface 10 !! 3.3 ! 05-2009 (G.Garric) addition of the lim2_evp case 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_lim2 … … 17 18 !!---------------------------------------------------------------------- 18 19 USE oce ! ocean dynamics and tracers 19 USE c1d ! 1d configuration20 20 USE dom_oce ! ocean space and time domain 21 21 USE lib_mpp … … 53 53 PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90 54 54 55 CHARACTER(len=1) :: cl_grid = 'B' ! type of grid used in ice dynamics56 57 55 !! * Substitutions 58 56 # include "domzgr_substitute.h90" … … 61 59 !! NEMO/SBC 3.0 , LOCEAN-IPSL (2008) 62 60 !! $Id$ 63 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)61 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 64 62 !!---------------------------------------------------------------------- 65 63 … … 172 170 ! Ice model step ! 173 171 ! ---------------- ! 172 numit = numit + nn_fsbc ! Ice model time step 174 173 175 174 CALL lim_rst_opn_2 ( kt ) ! Open Ice restart file 176 IF( .NOT. lk_c1d ) THEN ! Ice dynamics & transport (not in 1D case) 175 #if ! defined key_c1d 176 ! Ice dynamics & transport (not in 1D case) 177 177 CALL lim_dyn_2 ( kt ) ! Ice dynamics ( rheology/dynamics ) 178 178 CALL lim_trp_2 ( kt ) ! Ice transport ( Advection/diffusion ) 179 179 IF( ln_limdmp ) CALL lim_dmp_2 ( kt ) ! Ice damping 180 ENDIF 180 #endif 181 181 #if defined key_coupled 182 182 IF( ksbc == 5 ) CALL sbc_cpl_ice_flx( reshape( frld, (/jpi,jpj,1/) ), & -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcmod.F90
r2228 r2236 8 8 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) Forcing averaged over 2 time steps 9 9 !! 3.3 ! 2010-10 (S. Masson) add diurnal cycle 10 !! 3.3 ! 09-2010 (D. Storkey) add ice boundary conditions (BDY) 10 11 !!---------------------------------------------------------------------- 11 12 … … 34 35 USE sbcfwb ! surface boundary condition: freshwater budget 35 36 USE closea ! closed sea 37 USE bdy_par ! unstructured open boundary data variables 38 USE bdyice ! unstructured open boundary data (bdy_ice routine) 36 39 37 40 USE prtctl ! Print control (prt_ctl routine) … … 53 56 !! NEMO/OPA 3.3 , NEMO-consortium (2010) 54 57 !! $Id$ 55 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)58 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 56 59 !!---------------------------------------------------------------------- 57 60 CONTAINS … … 238 241 ! 239 242 CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM 2.0 ice model 243 IF( lk_bdy ) CALL bdy_ice( kt ) 240 244 ! 241 245 CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc, nn_ico_cpl) ! LIM 3.0 ice model -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcrnf.F90
r2148 r2236 25 25 PRIVATE 26 26 27 PUBLIC sbc_rnf ! routine call in step module 28 29 ! !!* namsbc_rnf namelist * 27 PUBLIC sbc_rnf ! routine call in sbcmod module 28 PUBLIC sbc_rnf_div ! routine called in sshwzv module 29 30 ! !!* namsbc_rnf namelist * 30 31 CHARACTER(len=100), PUBLIC :: cn_dir = './' !: Root directory for location of ssr files 32 LOGICAL , PUBLIC :: ln_rnf_depth = .false. !: depth river runoffs attribute specified in a file 33 LOGICAL , PUBLIC :: ln_rnf_temp = .false. !: temperature river runoffs attribute specified in a file 34 LOGICAL , PUBLIC :: ln_rnf_sal = .false. !: salinity river runoffs attribute specified in a file 31 35 LOGICAL , PUBLIC :: ln_rnf_emp = .false. !: runoffs into a file to be read or already into precipitation 32 36 TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read 33 37 TYPE(FLD_N) , PUBLIC :: sn_cnf !: information about the runoff mouth file to be read 34 TYPE(FLD_N) :: sn_s al_rnf!: information about the salinities of runoff file to be read35 TYPE(FLD_N) :: sn_t mp_rnf!: information about the temperatures of runoff file to be read38 TYPE(FLD_N) :: sn_s_rnf !: information about the salinities of runoff file to be read 39 TYPE(FLD_N) :: sn_t_rnf !: information about the temperatures of runoff file to be read 36 40 TYPE(FLD_N) :: sn_dep_rnf !: information about the depth which river inflow affects 37 41 LOGICAL , PUBLIC :: ln_rnf_mouth = .false. !: specific treatment in mouths vicinity 38 42 REAL(wp) , PUBLIC :: rn_hrnf = 0.e0 !: runoffs, depth over which enhanced vertical mixing is used 39 43 REAL(wp) , PUBLIC :: rn_avt_rnf = 0.e0 !: runoffs, value of the additional vertical mixing coef. [m2/s] 40 LOGICAL , PUBLIC :: ln_rnf_att = .false. !: river runoffs attributes (temp, sal & depth) are specified in a file41 44 REAL(wp) , PUBLIC :: rn_rfact = 1.e0 !: multiplicative factor for runoff 42 45 43 INTEGER , PUBLIC :: nkrnf = 0 !: number of levels over which Kz is increased at river mouths44 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rnfmsk !: river mouth mask (hori.)45 REAL(wp), PUBLIC, DIMENSION(jpk) :: rnfmsk_z !: river mouth mask (vert.)46 47 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf 48 49 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_s al_rnf!: structure of input river runoff salinity (file information, fields read)50 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_t em_rnf!: structure of input river runoff temperature (file information, fields read)46 INTEGER , PUBLIC :: nkrnf = 0 !: number of levels over which Kz is increased at river mouths 47 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rnfmsk !: river mouth mask (hori.) 48 REAL(wp), PUBLIC, DIMENSION(jpk) :: rnfmsk_z !: river mouth mask (vert.) 49 50 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf !: structure of input river runoff (file information, fields read) 51 52 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_s_rnf !: structure of input river runoff salinity (file information, fields read) 53 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_t_rnf !: structure of input river runoff temperature (file information, fields read) 51 54 52 REAL, PUBLIC, DIMENSION(jpi,jpj) :: rnf_dep !: depth of runoff in m 53 INTEGER, PUBLIC, DIMENSION(jpi,jpj) :: rnf_mod_dep !: depth of runoff in model levels 54 REAL, PUBLIC, DIMENSION(jpi,jpj) :: rnf_sal !: salinity of river runoff 55 REAL, PUBLIC, DIMENSION(jpi,jpj) :: rnf_tmp !: temperature of river runoff 56 57 INTEGER :: ji, jj ,jk ! dummy loop indices 58 INTEGER :: inum ! temporary logical unit 59 55 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: h_rnf !: depth of runoff in m 56 INTEGER, PUBLIC, DIMENSION(jpi,jpj) :: nk_rnf !: depth of runoff in model levels 57 58 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2) :: tsc_rnf !: temperature & salinity content of river runoffs [K.m/s & PSU.m/s] 59 60 60 !! * Substitutions 61 61 # include "domzgr_substitute.h90" 62 63 62 !!---------------------------------------------------------------------- 64 63 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 65 64 !! $Id$ 66 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)65 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 67 66 !!---------------------------------------------------------------------- 68 67 … … 84 83 !! 85 84 INTEGER :: ji, jj ! dummy loop indices 85 REAL(wp) :: z1_rau0 ! local scalar 86 86 !!---------------------------------------------------------------------- 87 87 ! 88 IF( kt == nit000 ) CALL sbc_rnf_init ! Read namelist and allocate structures88 IF( kt == nit000 ) CALL sbc_rnf_init ! Read namelist and allocate structures 89 89 90 90 ! !-------------------! … … 92 92 ! !-------------------! 93 93 ! 94 CALL fld_read( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provides it 95 ! ! at the current time-step 96 IF ( ln_rnf_att ) THEN 97 CALL fld_read ( kt, nn_fsbc, sf_sal_rnf ) 98 CALL fld_read ( kt, nn_fsbc, sf_tem_rnf ) 99 ENDIF 94 CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt 95 IF( ln_rnf_temp ) CALL fld_read ( kt, nn_fsbc, sf_t_rnf ) ! idem for runoffs temperature if required 96 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required 100 97 101 98 ! Runoff reduction only associated to the ORCA2_LIM configuration … … 113 110 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 114 111 rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) 115 IF ( ln_rnf_att ) THEN 116 rnf_sal(:,:) = ( sf_sal_rnf(1)%fnow(:,:,1) ) 117 rnf_tmp(:,:) = ( sf_tem_rnf(1)%fnow(:,:,1) ) 118 ELSE 119 rnf_sal(:,:) = 0 120 rnf_tmp(:,:) = -999 112 ! 113 z1_rau0 = 1.e0 / rau0 114 ! ! set temperature & salinity content of runoffs 115 IF( ln_rnf_temp ) THEN ! use runoffs temperature data 116 tsc_rnf(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * z1_rau0 117 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999 ) ! if missing data value use SST as runoffs temperature 118 tsc_rnf(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * z1_rau0 119 ENDWHERE 120 ELSE ! use SST as runoffs temperature 121 tsc_rnf(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * z1_rau0 121 122 ENDIF 122 CALL iom_put( "runoffs", rnf ) ! runoffs 123 ! ! use runoffs salinity data 124 IF( ln_rnf_sal ) tsc_rnf(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * z1_rau0 125 ! ! else use S=0 for runoffs (done one for all in the init) 126 ! 127 IF( ln_rnf_temp .OR. ln_rnf_sal ) THEN ! runoffs as outflow: use ocean SST and SSS 128 WHERE( rnf(:,:) < 0.e0 ) ! example baltic model when flow is out of domain 129 tsc_rnf(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * z1_rau0 130 tsc_rnf(:,:,jp_sal) = sss_m(:,:) * rnf(:,:) * z1_rau0 131 ENDWHERE 132 ENDIF 133 134 CALL iom_put( "runoffs", rnf ) ! output runoffs arrays 123 135 ENDIF 124 136 ! … … 127 139 END SUBROUTINE sbc_rnf 128 140 141 SUBROUTINE sbc_rnf_div( phdivn ) 142 !!---------------------------------------------------------------------- 143 !! *** ROUTINE sbc_rnf *** 144 !! 145 !! ** Purpose : update the horizontal divergence with the runoff inflow 146 !! 147 !! ** Method : 148 !! CAUTION : rnf is positive (inflow) decreasing the 149 !! divergence and expressed in m/s 150 !! 151 !! ** Action : phdivn decreased by the runoff inflow 152 !!---------------------------------------------------------------------- 153 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdivn ! horizontal divergence 154 !! 155 INTEGER :: ji, jj, jk ! dummy loop indices 156 REAL(wp) :: z1_rau0 ! local scalar 157 !!---------------------------------------------------------------------- 158 ! 159 z1_rau0 = 1.e0 / rau0 160 IF( ln_rnf_depth ) THEN !== runoff distributed over several levels ==! 161 IF( lk_vvl ) THEN ! variable volume case 162 DO jj = 1, jpj ! update the depth over which runoffs are distributed 163 DO ji = 1, jpi 164 h_rnf(ji,jj) = 0.e0 165 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres 166 h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) ! to the bottom of the relevant grid box 167 END DO 168 ! ! apply the runoff input flow 169 DO jk = 1, nk_rnf(ji,jj) 170 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - rnf(ji,jj) * z1_rau0 / h_rnf(ji,jj) 171 END DO 172 END DO 173 END DO 174 ELSE ! constant volume case : just apply the runoff input flow 175 DO jj = 1, jpj 176 DO ji = 1, jpi 177 DO jk = 1, nk_rnf(ji,jj) 178 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - rnf(ji,jj) * z1_rau0 / h_rnf(ji,jj) 179 END DO 180 END DO 181 END DO 182 ENDIF 183 ELSE !== runoff put only at the surface ==! 184 phdivn(:,:,1) = phdivn(:,:,1) - rnf(:,:) * z1_rau0 / fse3t(:,:,1) 185 ENDIF 186 ! 187 END SUBROUTINE sbc_rnf_div 188 129 189 130 190 SUBROUTINE sbc_rnf_init … … 138 198 !! ** Action : - read parameters 139 199 !!---------------------------------------------------------------------- 140 INTEGER :: ierror ! temporary integer141 200 CHARACTER(len=32) :: rn_dep_file ! runoff file name 201 INTEGER :: inum ! temporary integers 202 INTEGER :: ierror ! temporary integer 142 203 !! 143 NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, sn_rnf, sn_cnf, sn_sal_rnf, sn_tmp_rnf, sn_dep_rnf, & 144 & ln_rnf_mouth, ln_rnf_att, rn_hrnf, rn_avt_rnf, rn_rfact 204 NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_temp, ln_rnf_sal, & 205 & sn_rnf, sn_cnf , sn_s_rnf , sn_t_rnf , sn_dep_rnf, & 206 & ln_rnf_mouth , rn_hrnf , rn_avt_rnf , rn_rfact 145 207 !!---------------------------------------------------------------------- 146 208 … … 154 216 sn_cnf = FLD_N( 'runoffs', 0 , 'sorunoff' , .FALSE. , .true. , 'yearly' , '' , '' ) 155 217 156 sn_s al_rnf = FLD_N( 'runoffs', 24. , 'rosaline' , .TRUE. , .true. , 'yearly' , '' , '' )157 sn_t mp_rnf = FLD_N( 'runoffs', 24. , 'rotemper' , .TRUE. , .true. , 'yearly' , '' , '' )218 sn_s_rnf = FLD_N( 'runoffs', 24. , 'rosaline' , .TRUE. , .true. , 'yearly' , '' , '' ) 219 sn_t_rnf = FLD_N( 'runoffs', 24. , 'rotemper' , .TRUE. , .true. , 'yearly' , '' , '' ) 158 220 sn_dep_rnf = FLD_N( 'runoffs', 0. , 'rodepth' , .FALSE. , .true. , 'yearly' , '' , '' ) 159 221 ! … … 178 240 ! ! ================== 179 241 ! 180 IF( ln_rnf_emp ) THEN ! runoffs directly provided in the precipitations242 IF( ln_rnf_emp ) THEN !== runoffs directly provided in the precipitations ==! 181 243 IF(lwp) WRITE(numout,*) 182 244 IF(lwp) WRITE(numout,*) ' runoffs directly provided in the precipitations' 183 IF ( ln_rnf_att ) THEN 184 CALL ctl_warn( 'runoffs already included in precipitations & so runoff attributes will not be used' ) 185 ln_rnf_att = .FALSE. 186 ENDIF 187 ! 188 ELSE ! runoffs read in a file : set sf_rnf structure 189 ! 190 ! Allocate sf_rnf structure and (if required) sf_sal_rnf and sf_tem_rnf structures 191 ALLOCATE( sf_rnf(1), STAT=ierror ) 245 IF( ln_rnf_depth .OR. ln_rnf_temp .OR. ln_rnf_sal ) THEN 246 CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' ) 247 ln_rnf_depth = .FALSE. ; ln_rnf_temp = .FALSE. ; ln_rnf_sal = .FALSE. 248 ENDIF 249 ! 250 ELSE !== runoffs read in a file : set sf_rnf structure ==! 251 ! 252 ALLOCATE( sf_rnf(1), STAT=ierror ) ! Create sf_rnf structure (runoff inflow) 253 IF(lwp) WRITE(numout,*) 254 IF(lwp) WRITE(numout,*) ' runoffs inflow read in a file' 192 255 IF( ierror > 0 ) THEN 193 256 CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' ) ; RETURN 194 257 ENDIF 195 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) ) 196 ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 197 198 IF( ln_rnf_att ) THEN 199 ALLOCATE( sf_sal_rnf(1), STAT=ierror ) 258 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) ) 259 IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 260 ! ! fill sf_rnf with the namelist (sn_rnf) and control print 261 CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' ) 262 ! 263 IF( ln_rnf_temp ) THEN ! Create (if required) sf_t_rnf structure 264 IF(lwp) WRITE(numout,*) 265 IF(lwp) WRITE(numout,*) ' runoffs temperatures read in a file' 266 ALLOCATE( sf_t_rnf(1), STAT=ierror ) 200 267 IF( ierror > 0 ) THEN 201 CALL ctl_stop( 'sbc_ sal_rnf: unable to allocate sf_sal_rnf structure' ) ; RETURN268 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' ) ; RETURN 202 269 ENDIF 203 ALLOCATE( sf_sal_rnf(1)%fnow(jpi,jpj,1) ) 204 ALLOCATE( sf_sal_rnf(1)%fdta(jpi,jpj,1,2) ) 205 206 ALLOCATE( sf_tem_rnf(1), STAT=ierror ) 270 ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1) ) 271 IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 272 CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 273 ENDIF 274 ! 275 IF( ln_rnf_sal ) THEN ! Create (if required) sf_s_rnf and sf_t_rnf structures 276 IF(lwp) WRITE(numout,*) 277 IF(lwp) WRITE(numout,*) ' runoffs salinities read in a file' 278 ALLOCATE( sf_s_rnf(1), STAT=ierror ) 207 279 IF( ierror > 0 ) THEN 208 CALL ctl_stop( 'sbc_tmp_rnf: unable to allocate sf_tem_rnf structure' ) ; RETURN280 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' ) ; RETURN 209 281 ENDIF 210 ALLOCATE( sf_ tem_rnf(1)%fnow(jpi,jpj,1))211 ALLOCATE( sf_tem_rnf(1)%fdta(jpi,jpj,1,2) )212 ENDIF213 ! fill sf_rnf with sn_rnf and control print214 CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' ) 282 ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1) ) 283 IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 284 CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 285 ENDIF 286 215 287 216 IF ( ln_rnf_att ) THEN 217 CALL fld_fill (sf_sal_rnf, (/ sn_sal_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 218 CALL fld_fill (sf_tem_rnf, (/ sn_tmp_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 219 288 IF ( ln_rnf_depth ) THEN ! depth of runoffs set from a file 289 IF(lwp) WRITE(numout,*) 290 IF(lwp) WRITE(numout,*) ' runoffs depth read in a file' 220 291 rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 221 292 CALL iom_open ( rn_dep_file, inum ) ! open file 222 CALL iom_get ( inum, jpdom_data, sn_dep_rnf%clvar, rnf_dep) ! read the river mouth array293 CALL iom_get ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf ) ! read the river mouth array 223 294 CALL iom_close( inum ) ! close file 224 295 225 rnf_mod_dep(:,:) = 0. 226 DO jj = 1, jpj 227 DO ji = 1, jpi 228 IF ( rnf_dep(ji,jj) > 0.e0 ) THEN 229 jk = 2 230 DO WHILE ( jk /= jpkm1 .AND. fsdept(ji,jj,jk) < rnf_dep(ji,jj) ) ; jk = jk + 1 ; ENDDO 231 rnf_mod_dep(ji,jj) = jk 232 ELSE IF ( rnf_dep(ji,jj) == -1. ) THEN 233 rnf_mod_dep(ji,jj) = 1. 234 ELSE IF ( rnf_dep(ji,jj) == -999 ) THEN 235 rnf_mod_dep(ji,jj) = jpkm1 236 ELSE IF ( rnf_dep(ji,jj) /= 0. ) THEN 296 nk_rnf(:,:)=0 ! set the number of level over which river runoffs are applied 297 DO jj=1,jpj 298 DO ji=1,jpi 299 IF ( h_rnf(ji,jj) > 0.e0 ) THEN 300 jk=2 301 DO WHILE ( jk/=(mbathy(ji,jj)-1) .AND. fsdept(ji,jj,jk) < h_rnf(ji,jj) ); jk=jk+1; ENDDO 302 nk_rnf(ji,jj)=jk 303 ELSE IF ( h_rnf(ji,jj) == -1 ) THEN ; nk_rnf(ji,jj)=1 304 ELSE IF ( h_rnf(ji,jj) == -999 ) THEN ; nk_rnf(ji,jj)=mbathy(ji,jj)-1 305 ELSE IF ( h_rnf(ji,jj) /= 0 ) THEN 237 306 CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999' ) 238 307 WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, rnf(ji,jj) … … 240 309 ENDDO 241 310 ENDDO 242 ELSE 243 rnf_mod_dep(:,:) = 1. 311 DO jj=1,jpj ! set the associated depth 312 DO ji=1,jpi 313 h_rnf(ji,jj)=0.e0 314 DO jk=1,nk_rnf(ji,jj) 315 h_rnf(ji,jj)=h_rnf(ji,jj)+fse3t(ji,jj,jk) 316 ENDDO 317 ENDDO 318 ENDDO 319 ELSE ! runoffs applied at the surface 320 nk_rnf(:,:)=1 321 h_rnf(:,:)=fse3t(:,:,1) 244 322 ENDIF 245 323 ! 246 324 ENDIF 247 ! 248 325 326 tsc_rnf(:,:,:) = 0.e0 ! runoffs temperature & salinty contents initilisation 249 327 ! ! ======================== 250 328 ! ! River mouth vicinity … … 256 334 ! ! - mixed upstream-centered (ln_traadv_cen2=T) 257 335 ! 258 ! ! Number of level over which Kz increase259 IF ( ln_rnf_att ) &260 & CALL ctl_warn( 'increased mixing turned on but effects may already be spread through depth by ln_rnf_att' )261 nkrnf = 0 336 IF ( ln_rnf_depth ) CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already', & 337 & 'be spread through depth by ln_rnf_depth' ) 338 ! 339 nkrnf = 0 ! Number of level over which Kz increase 262 340 IF( rn_hrnf > 0.e0 ) THEN 263 341 nkrnf = 2 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcssm.F90
r1715 r2236 29 29 !! OPA 9.0 , LOCEAN-IPSL (2006) 30 30 !! $Id$ 31 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)31 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 32 32 !!---------------------------------------------------------------------- 33 33 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcssr.F90
r1951 r2236 48 48 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 49 49 !! $Id$ 50 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)50 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 51 51 !!---------------------------------------------------------------------- 52 52 … … 115 115 CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' ) ; RETURN 116 116 ENDIF 117 ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1 ) ) 118 ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) ) 117 ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1) ) 119 118 ! 120 119 ! fill sf_sst with sn_sst and control print 121 120 CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' ) 121 IF( sf_sst(1)%ln_tint ) ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) ) 122 122 ENDIF 123 123 ! … … 128 128 CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' ) ; RETURN 129 129 ENDIF 130 ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1 ) ) 131 ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) ) 130 ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1) ) 132 131 ! 133 132 ! fill sf_sss with sn_sss and control print 134 133 CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' ) 134 IF( sf_sss(1)%ln_tint )ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) ) 135 135 ENDIF 136 136 ! -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/sol_oce.F90
r1601 r2236 52 52 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 53 53 !! $Id$ 54 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)54 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 55 55 !!---------------------------------------------------------------------- 56 56 END MODULE sol_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solmat.F90
r2224 r2236 15 15 !! 3.2 ! 2009-06 (S. Masson) distributed restart using iom 16 16 !! - ! 2009-07 (R. Benshila) suppression of rigid-lid option 17 !! 3.3 ! 2010-09 (D. Storkey) update for BDY module. 17 18 !!---------------------------------------------------------------------- 18 19 … … 26 27 USE phycst ! physical constants 27 28 USE obc_oce ! ocean open boundary conditions 29 USE bdy_oce ! unstructured open boundary conditions 28 30 USE lbclnk ! lateral boudary conditions 29 31 USE lib_mpp ! distributed memory computing … … 38 40 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 39 41 !! $Id$ 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)42 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 41 43 !!---------------------------------------------------------------------- 42 44 … … 80 82 ENDIF 81 83 82 #if defined key_dynspg_flt 84 #if defined key_dynspg_flt && ! defined key_bdy 83 85 # if ! defined key_obc 84 86 … … 158 160 ENDIF 159 161 # endif 162 163 # elif defined key_dynspg_flt && defined key_bdy 164 165 ! defined gcdmat in the case of unstructured open boundaries 166 DO jj = 2, jpjm1 167 DO ji = 2, jpim1 168 zcoef = z2dt * z2dt * grav * bmask(ji,jj) 169 170 ! south coefficient 171 zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1) 172 zcoefs = zcoefs * bdyvmask(ji,jj-1) 173 gcp(ji,jj,1) = zcoefs 174 175 ! west coefficient 176 zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj) 177 zcoefw = zcoefw * bdyumask(ji-1,jj) 178 gcp(ji,jj,2) = zcoefw 179 180 ! east coefficient 181 zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj) 182 zcoefe = zcoefe * bdyumask(ji,jj) 183 gcp(ji,jj,3) = zcoefe 184 185 ! north coefficient 186 zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj) 187 zcoefn = zcoefn * bdyvmask(ji,jj) 188 gcp(ji,jj,4) = zcoefn 189 190 ! diagonal coefficient 191 gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) & 192 - zcoefs -zcoefw -zcoefe -zcoefn 193 END DO 194 END DO 195 160 196 #endif 161 197 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solpcg.F90
r1976 r2236 26 26 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 27 27 !! $Id$ 28 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)28 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 29 29 !!---------------------------------------------------------------------- 30 30 CONTAINS -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solsor.F90
r1976 r2236 32 32 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 33 33 !! $Id$ 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)34 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 35 35 !!---------------------------------------------------------------------- 36 36 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solver.F90
r1976 r2236 33 33 !! NEMO/OPA 9.0 , LOCEAN-IPSL (2009) 34 34 !! $Id$ 35 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)35 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- 37 37 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/eosbn2.F90
r2104 r2236 64 64 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 65 65 !! $Id$ 66 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)66 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 67 67 !!---------------------------------------------------------------------- 68 68 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv.F90
r2104 r2236 51 51 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 52 52 !! $Id$ 53 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)53 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 54 54 !!---------------------------------------------------------------------- 55 55 … … 83 83 zwn(:,:,jpk) = 0.e0 ! no transport trough the bottom 84 84 ! 85 IF( lk_traldf_eiv ) CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary) 85 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & 86 & CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary) 86 87 ! 87 88 CALL iom_put( "uoce_eff", zun ) ! output effective transport 88 89 CALL iom_put( "voce_eff", zvn ) 89 90 CALL iom_put( "woce_eff", zwn ) 90 91 91 92 92 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! … … 97 97 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 98 98 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 99 99 100 ! 100 101 CASE (-1 ) !== esopa: test all possibility with control print ==! -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r2104 r2236 48 48 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 49 49 !! $Id$ 50 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)50 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 51 51 !!---------------------------------------------------------------------- 52 52 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r2104 r2236 41 41 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 42 42 !! $Id$ 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)43 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- 45 45 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r2104 r2236 40 40 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 41 41 !! $Id$ 42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)42 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- 44 44 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r2104 r2236 38 38 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)40 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 41 41 !!---------------------------------------------------------------------- 42 42 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_qck.F90
r2104 r2236 41 41 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 42 42 !! $Id: $ 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)43 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- 45 45 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r2104 r2236 47 47 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 48 48 !! $Id$ 49 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)49 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 50 50 !!---------------------------------------------------------------------- 51 51 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r2104 r2236 36 36 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 37 37 !! $Id$ 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)38 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 39 39 !!---------------------------------------------------------------------- 40 40 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trabbc.F90
r2148 r2236 44 44 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 45 45 !! $Id$ 46 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)46 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 47 47 !!---------------------------------------------------------------------- 48 48 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trabbl.F90
r2148 r2236 74 74 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 75 75 !! $Id$ 76 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)76 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 77 77 !!---------------------------------------------------------------------- 78 78 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/tradmp.F90
r2104 r2236 51 51 LOGICAL, PUBLIC :: lk_tradmp = .TRUE. !: internal damping flag 52 52 #endif 53 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: strdmp !: damping salinity trend (psu/s) 54 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: ttrdmp !: damping temperature trend (Centigrade/s) 53 55 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: resto !: restoring coeff. on T and S (s-1) 54 56 … … 67 69 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 68 70 !! $Id$ 69 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)71 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 70 72 !!---------------------------------------------------------------------- 71 73 … … 92 94 INTEGER, INTENT(in) :: kt ! ocean time-step index 93 95 !! 96 REAL(wp) :: zta, zsa ! temporary scalars 94 97 INTEGER :: ji, jj, jk ! dummy loop indices 95 98 REAL(wp) :: zta, zsa … … 112 115 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 113 116 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 117 ! save the salinity trend (used in asmtrj) 118 strdmp(ji,jj,jk) = zsa 119 ttrdmp(ji,jj,jk) = zta 114 120 END DO 115 121 END DO … … 123 129 zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) 124 130 zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) ) 125 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 126 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 131 ELSE 132 zta = 0.e0 133 zsa = 0.e0 127 134 ENDIF 135 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 136 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 137 ! save the salinity trend (used in asmtrj) 138 strdmp(ji,jj,jk) = zsa 139 ttrdmp(ji,jj,jk) = zta 128 140 END DO 129 141 END DO … … 137 149 zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) 138 150 zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) ) 139 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 140 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 151 ELSE 152 zta = 0.e0 153 zsa = 0.e0 141 154 ENDIF 155 ! add the trends to the general tracer trends 156 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 157 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 158 ! save the salinity trend (used in asmtrj) 159 strdmp(ji,jj,jk) = zsa 160 ttrdmp(ji,jj,jk) = zta 142 161 END DO 143 162 END DO … … 208 227 & CALL ctl_stop( 'no temperature and/or salinity data define key_dtatem and key_dtasal' ) 209 228 229 strdmp(:,:,:) = 0.e0 ! internal damping salinity trend (used in asmtrj) 230 ttrdmp(:,:,:) = 0.e0 210 231 ! ! Damping coefficients initialization 211 232 IF( lzoom ) THEN ; CALL dtacof_zoom( resto ) -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traldf.F90
- Property svn:executable deleted
r2104 r2236 21 21 USE traldf_bilap ! lateral mixing (tra_ldf_bilap routine) 22 22 USE traldf_iso ! lateral mixing (tra_ldf_iso routine) 23 USE traldf_iso_grif ! lateral mixing (tra_ldf_iso_grif routine) 23 24 USE traldf_lap ! lateral mixing (tra_ldf_lap routine) 24 25 USE trdmod_oce ! ocean space and time domain … … 46 47 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 47 48 !! $Id$ 48 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)49 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 49 50 !!---------------------------------------------------------------------- 50 51 … … 70 71 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 71 72 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level laplacian 72 CASE ( 1 ) ; CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! rotated laplacian 73 CASE ( 1 ) 74 IF ( ln_traldf_grif ) THEN 75 CALL tra_ldf_iso_grif ( kt ) ! Griffies quarter-cell formulation 76 ELSE 77 CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! rotated laplacian 78 ENDIF 73 79 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level bilaplacian 74 80 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, 'TRA', tsb, tsa, jpts ) ! s-coord. horizontal bilap. … … 78 84 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask, & 79 85 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 80 CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 86 IF ( ln_traldf_grif ) THEN 87 CALL tra_ldf_iso_grif ( kt ) 88 ELSE 89 CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 90 ENDIF 81 91 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask, & 82 92 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) … … 144 154 WRITE(numout,*) ' horizontal (geopotential) ln_traldf_hor = ', ln_traldf_hor 145 155 WRITE(numout,*) ' iso-neutral ln_traldf_iso = ', ln_traldf_iso 156 WRITE(numout,*) ' iso-neutral (Griffies) ln_traldf_grif = ', ln_traldf_grif 146 157 ENDIF 147 158 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traldf_iso.F90
r2104 r2236 45 45 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 46 46 !! $Id$ 47 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)47 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 48 48 !!---------------------------------------------------------------------- 49 49 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/tranpc.F90
r2104 r2236 33 33 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 34 34 !! $Id$ 35 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)35 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- 37 37 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/tranxt.F90
r2148 r2236 42 42 USE traqsr ! penetrative solar radiation (needed for nksr) 43 43 USE traswp ! swap array 44 USE obc_oce 45 #if defined key_agrif 44 46 USE agrif_opa_update 45 47 USE agrif_opa_interp 48 #endif 46 49 47 50 IMPLICIT NONE … … 60 63 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 61 64 !! $Id$ 62 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)65 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 63 66 !!---------------------------------------------------------------------- 64 67 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traqsr.F90
r2224 r2236 59 59 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 60 60 !! $Id$ 61 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)61 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 62 62 !!---------------------------------------------------------------------- 63 63 … … 380 380 ENDIF 381 381 ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1) ) 382 ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )382 IF( sn_chl%ln_tint )ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) ) 383 383 ! ! fill sf_chl with sn_chl and control print 384 384 CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init', & -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trasbc.F90
r2148 r2236 27 27 USE sbcmod ! ln_rnf 28 28 USE iom 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 30 30 31 IMPLICIT NONE … … 39 40 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 40 41 !! $Id$ 41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)42 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 42 43 !!---------------------------------------------------------------------- 43 44 … … 107 108 !! 108 109 INTEGER :: ji, jj, jk ! dummy loop indices 109 REAL(wp) :: zta, zsa, zrnf ! local scalars, adjustment to temperature and salinity110 REAL(wp) :: zsrau, zse3t, zdep ! local scalars, 1/density, 1/height of box, 1/height of effected water column111 REAL(wp) :: zdheat, zdsalt ! total change of temperature and salinity112 110 REAL(wp) :: zfact, z1_e3t ! 113 111 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds … … 179 177 END DO 180 178 ENDIF 181 ! Concentration dilution effect on (t,s) due to 182 ! river runoff without T, S and depth attributes 183 IF( ln_rnf ) THEN 184 ! 185 IF( lk_vvl ) THEN ! Variable Volume case 186 ! ! cooling/heating effect of runoff & No salinity concent./dilut. effect 187 DO jj = 2, jpj 188 DO ji = fs_2, fs_jpim1 ! vector opt. 189 sbc_hc_n(ji,jj) = sbc_hc_n(ji,jj) + zsrau * rnf(ji,jj) * tsn(ji,jj,1,jp_tem) 190 END DO 191 END DO 192 ELSE ! Constant Volume case 193 ! ! concent./dilut. effect only 194 DO jj = 2, jpj 195 DO ji = fs_2, fs_jpim1 ! vector opt. 196 sbc_sc_n(ji,jj) = sbc_sc_n(ji,jj) - zsrau * rnf(ji,jj) * tsn(ji,jj,1,jp_sal) 197 END DO 198 END DO 199 ENDIF 200 ! 201 ENDIF 202 ! Add to the general trend 203 ! ************************ 179 ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff 204 180 DO jj = 2, jpj 205 181 DO ji = fs_2, fs_jpim1 ! vector opt. … … 219 195 CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_sc_n ) 220 196 ENDIF 221 222 IF( ln_rnf .AND. ln_rnf_att ) THEN ! Concentration / dilution effect on (t,s) due to river runoff 223 ! 224 DO jj = 1, jpj 225 DO ji = 1, jpi 226 zdep = 1. / rnf_dep(ji,jj) 227 zse3t = 1. / fse3t(ji,jj,1) 228 rnf_dep(ji,jj) = 0.e0 229 DO jk = 1, rnf_mod_dep(ji,jj) ! recalculates rnf_dep to be the depth 230 rnf_dep(ji,jj) = rnf_dep(ji,jj) + fse3t(ji,jj,jk) ! in metres to the bottom of the relevant grid box 231 END DO 232 IF( rnf_tmp(ji,jj) == -999 ) rnf_tmp(ji,jj) = tsn(ji,jj,1,jp_tem) ! if not specified set runoff temp to be sst 233 234 IF( rnf(ji,jj) > 0.e0 ) THEN 235 ! 236 zrnf = rnf(ji,jj) * zsrau * zdep 237 IF( lk_vvl ) THEN 238 ! indirect flux, concentration or dilution effect : force a dilution effect in all levels 239 zdheat = 0.e0 240 zdsalt = 0.e0 241 DO jk = 1, rnf_mod_dep(ji,jj) 242 zta = -tsn(ji,jj,jk,jp_tem) * zrnf 243 zsa = -tsn(ji,jj,jk,jp_sal) * zrnf 244 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta ! add the trend to the general tracer trend 245 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 246 zdheat = zdheat + zta * fse3t(ji,jj,jk) 247 zdsalt = zdsalt + zsa * fse3t(ji,jj,jk) 248 END DO 249 ! negate this total change in heat and salt content from top level !!gm I don't understand this 250 tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) - zdheat * zse3t 251 tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) - zdsalt * zse3t 252 253 DO jk = 1, rnf_mod_dep(ji,jj) 254 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + rnf_tmp(ji,jj) * zrnf 255 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + rnf_sal(ji,jj) * zrnf 256 END DO 257 ELSE 258 DO jk = 1, rnf_mod_dep(ji,jj) 259 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( rnf_tmp(ji,jj) - tsn(ji,jj,jk,jp_tem) ) * zrnf 260 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + ( rnf_sal(ji,jj) - tsn(ji,jj,jk,jp_sal) ) * zrnf 261 END DO 262 ENDIF 263 264 ELSEIF( rnf(ji,jj) < 0.e0 ) THEN ! for use in baltic when flow is out of domain, want no change in temp and sal 265 266 IF( lk_vvl ) THEN 267 ! calculate automatic adjustment to sal and temp due to dilution/concentraion effect 268 zrnf = rnf(ji,jj) * zsrau * zse3t 269 tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + tsn(ji,jj,1,jp_tem) * zrnf 270 tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) + tsn(ji,jj,1,jp_sal) * zrnf 271 ENDIF 272 273 ENDIF 274 275 END DO 276 END DO 277 ! 197 ! !== Runoffs ==! 198 ! Effect on (t,s) due to river runoff (dilution effect automatically applied via vertical tracer advection) 199 IF( ln_rnf ) THEN 200 DO jj = 2, jpj 201 DO ji = fs_2, fs_jpim1 202 zdep = 1. / h_rnf(ji,jj) 203 IF ( rnf(ji,jj) .ne. 0.0 ) THEN 204 DO jk = 1, nk_rnf(ji,jj) 205 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + tsc_rnf(ji,jj,jp_tem) * zdep 206 IF( ln_rnf_sal ) tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + tsc_rnf(ji,jj,jp_sal) * zdep 207 ENDDO 208 ENDIF 209 ENDDO 210 ENDDO 278 211 ENDIF 212 !!gm It should be useless 213 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 279 214 280 215 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trazdf.F90
r2104 r2236 49 49 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 50 50 !! $Id$ 51 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)51 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 52 52 !!---------------------------------------------------------------------- 53 53 … … 121 121 USE zdftke_old 122 122 USE zdftke 123 USE zdfgls 123 124 USE zdfkpp 124 125 !!---------------------------------------------------------------------- … … 130 131 131 132 ! Force implicit schemes 132 IF( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdf kpp ) nzdf = 1 ! TKEor KPP physics133 IF( ln_traldf_iso ) nzdf = 1 ! iso-neutral lateral physics134 IF( ln_traldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate133 IF( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) nzdf = 1 ! TKE, GLS or KPP physics 134 IF( ln_traldf_iso ) nzdf = 1 ! iso-neutral lateral physics 135 IF( ln_traldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 135 136 IF( ln_zdfexp .AND. nzdf == 1 ) CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator', & 136 137 & ' TKE or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' ) -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trazdf_exp.F90
r2104 r2236 43 43 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 44 44 !! $Id$ 45 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)45 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 46 46 !!---------------------------------------------------------------------- 47 47 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r2104 r2236 46 46 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 47 47 !! $Id$ 48 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)48 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 49 49 !!---------------------------------------------------------------------- 50 50 CONTAINS … … 141 141 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 142 142 #if defined key_ldfslp 143 IF( ln_traldf_grif ) THEN 144 DO jk = 2, jpkm1 145 DO jj = 2, jpjm1 146 DO ji = fs_2, fs_jpim1 ! vector opt. 147 zavi = fsahtw(ji,jj,jk) * wslp2(ji,jj,jk) ! vertical mixing coef. due to lateral mixing 148 zwt(ji,jj,jk) = avt(ji,jj,jk) + zavi ! zwt=avt+zavi (total vertical mixing coef. on temperature) 149 END DO 150 END DO 151 END DO 143 152 ! update and save of avt (and avs if double diffusive mixing) 144 IF( l_traldf_rot ) THEN153 ELSE IF( l_traldf_rot ) THEN 145 154 DO jk = 2, jpkm1 146 155 DO jj = 2, jpjm1 … … 172 181 END DO 173 182 END DO 174 ! Surface boudary conditions175 DO jj = 2, jpjm1176 DO ji = fs_2, fs_jpim1 ! vector opt.177 ze3ta = ( 1. - znvvl ) + znvvl * fse3t_a(ji,jj,1) ! after scale factor at T-point178 zwi(ji,jj,1) = 0.e0179 zwd(ji,jj,1) = ze3ta - zws(ji,jj,1)180 END DO181 END DO182 183 ! first recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) 183 184 DO jj = 2, jpjm1 … … 196 197 ELSE IF( ( cdtype == 'TRA' .AND. jn == jp_sal ) .OR. ( cdtype == 'TRC' .AND. jn == 1 ) ) THEN 197 198 #if defined key_ldfslp 198 ! update and save of avt (and avs if double diffusive mixing) 199 IF( l_traldf_rot ) THEN 199 IF( ln_traldf_grif ) THEN 200 DO jk = 2, jpkm1 201 DO jj = 2, jpjm1 202 DO ji = fs_2, fs_jpim1 ! vector opt. 203 zavi = fsahtw(ji,jj,jk) * wslp2(ji,jj,jk) ! vertical mixing coef. due to lateral mixing 204 zwt(ji,jj,jk) = fsavs(ji,jj,jk) + zavi ! zwt=avt+zavi (total vertical mixing coef. on temperature) 205 END DO 206 END DO 207 END DO 208 ELSE IF( l_traldf_rot ) THEN 200 209 DO jk = 2, jpkm1 201 210 DO jj = 2, jpjm1 … … 273 282 END DO 274 283 END DO 275 276 ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 277 ! Save the masked temperature after in ta 278 ! (c a u t i o n: temperature not its trend, Leap-frog scheme done it will not be done in tranxt) 284 285 ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 279 286 DO jj = 2, jpjm1 280 287 DO ji = fs_2, fs_jpim1 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdicp.F90
r2104 r2236 45 45 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 46 46 !! $Id$ 47 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)47 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 48 48 !!---------------------------------------------------------------------- 49 49 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdicp_oce.F90
r1601 r2236 86 86 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 87 87 !! $Id$ 88 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)88 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 89 89 !!====================================================================== 90 90 END MODULE trdicp_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmld_oce.F90
r1152 r2236 85 85 !! OPA 9.0 , LOCEAN-IPSL (2005) 86 86 !! $Id$ 87 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)87 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 88 88 !!====================================================================== 89 89 END MODULE trdmld_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmld_rst.F90
r1715 r2236 25 25 !! OPA 9.0 , LOCEAN-IPSL (2006) 26 26 !! $Id$ 27 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)27 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 28 28 !!--------------------------------------------------------------------------------- 29 29 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmod.F90
r2104 r2236 39 39 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 40 40 !! $Id$ 41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)41 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 42 42 !!---------------------------------------------------------------------- 43 43 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmod_oce.F90
r2104 r2236 75 75 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 76 76 !! $Id$ 77 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)77 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 78 78 !!====================================================================== 79 79 END MODULE trdmod_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdvor.F90
r1715 r2236 66 66 !! OPA 9.0 , LOCEAN-IPSL (2005) 67 67 !! $Id$ 68 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)68 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 69 69 !!---------------------------------------------------------------------- 70 70 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdvor_oce.F90
r1152 r2236 36 36 !! OPA 9.0 , LOCEAN-IPSL (2005) 37 37 !! $Id$ 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)38 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 39 39 !!====================================================================== 40 40 END MODULE trdvor_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdf_oce.F90
r1601 r2236 41 41 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 42 42 !! $Id$ 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)43 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 44 44 !!====================================================================== 45 45 END MODULE zdf_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r2104 r2236 30 30 31 31 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: bfrua , bfrva !: Bottom friction coefficients set in zdfbfr 32 #if defined key_zdfgls 33 REAL(wp), PUBLIC :: rn_hbro = 0.003_wp ! Bottom roughness (m) 34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: wbotu, wbotv ! Bottom stresses 35 #endif 32 36 33 37 ! !!* Namelist nambfr: bottom friction namelist * … … 46 50 !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 47 51 !! $Id$ 48 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)52 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 49 53 !!---------------------------------------------------------------------- 50 54 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfddm.F90
r2104 r2236 42 42 !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 43 43 !! $Id$ 44 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)44 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 45 45 !!---------------------------------------------------------------------- 46 46 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfevd.F90
r1681 r2236 33 33 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 34 34 !! $Id$ 35 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)35 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- 37 37 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfini.F90
r1601 r2236 20 20 USE zdftke_old ! TKE vertical mixing (old scheme) 21 21 USE zdftke ! TKE vertical mixing 22 USE zdfgls ! GLS vertical mixing 22 23 USE zdfkpp ! KPP vertical mixing 23 24 USE zdfddm ! double diffusion mixing … … 39 40 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 40 41 !! $Id$ 41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)42 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 42 43 !!---------------------------------------------------------------------- 43 44 … … 106 107 ioptio = ioptio+1 107 108 ENDIF 109 IF( lk_zdfgls ) THEN 110 IF(lwp) WRITE(numout,*) ' GLS dependent eddy coefficients' 111 ioptio = ioptio+1 112 ENDIF 108 113 IF( lk_zdfkpp ) THEN 109 114 IF(lwp) WRITE(numout,*) ' KPP dependent eddy coefficients' … … 128 133 IF(lwp) WRITE(numout,*) ' use the 1.5 turbulent closure' 129 134 ENDIF 135 IF( lk_zdfgls ) THEN 136 IF(lwp) WRITE(numout,*) ' use the GLS closure scheme' 137 ENDIF 130 138 IF( lk_zdfkpp ) THEN 131 139 IF(lwp) WRITE(numout,*) ' use the KPP closure scheme' … … 136 144 ENDIF 137 145 IF ( ioptio > 1 .AND. .NOT. lk_esopa ) CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' ) 138 IF( ioptio == 0 .AND. .NOT.( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdf kpp ) ) &139 CALL ctl_stop( ' except for TKE sor KPP physics, a convection scheme is', &146 IF( ioptio == 0 .AND. .NOT.( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) ) & 147 CALL ctl_stop( ' except for TKE, GLS or KPP physics, a convection scheme is', & 140 148 & ' required: ln_zdfevd or ln_zdfnpc logicals' ) 141 149 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r2104 r2236 148 148 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 149 149 !! $Id$ 150 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)150 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 151 151 !!---------------------------------------------------------------------- 152 152 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r1585 r2236 31 31 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 32 32 !! $Id$ 33 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)33 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 34 34 !!---------------------------------------------------------------------- 35 35 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfric.F90
r2104 r2236 46 46 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 47 47 !! $Id$ 48 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)48 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 49 49 !!---------------------------------------------------------------------- 50 50 CONTAINS -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdftke.F90
r2104 r2236 89 89 90 90 REAL(wp), DIMENSION(jpi,jpj) :: htau ! depth of tke penetration (nn_htau) 91 REAL(wp), DIMENSION(jpi,jpj,jpk) :: en ! now turbulent kinetic energy [m2/s2]91 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: en ! now turbulent kinetic energy [m2/s2] 92 92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: dissl ! now mixing lenght of dissipation 93 93 … … 98 98 !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 99 99 !! $Id: $ 100 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)100 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 101 101 !!---------------------------------------------------------------------- 102 102 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdftke_old.F90
r2104 r2236 94 94 !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 95 95 !! $Id$ 96 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)96 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 97 97 !!---------------------------------------------------------------------- 98 98 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdftmx.F90
r2104 r2236 51 51 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 52 52 !! $Id: $ 53 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)53 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 54 54 !!---------------------------------------------------------------------- 55 55 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/istate.F90
r2148 r2236 35 35 USE in_out_manager ! I/O manager 36 36 USE iom ! I/O library 37 USE c1d ! re-initialization of u-v mask for the 1D configuration38 37 USE zpshde ! partial step: hor. derivative (zps_hde routine) 39 38 USE eosbn2 ! equation of state (eos bn2 routine) … … 56 55 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 57 56 !! $Id$ 58 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)57 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 59 58 !!---------------------------------------------------------------------- 60 59 … … 128 127 CALL tra_swap ! swap 3D arrays (tb,sb,tn,sn) in a 4D array 129 128 CALL eos( tsb, rhd, rhop ) ! before potential and in situ densities 130 IF( ln_zps .AND. .NOT. lk_c1d ) CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv, & ! zps: before hor. gradient 131 & rhd, gru , grv ) ! of t,s,rd at ocean bottom 129 #if ! defined key_c1d 130 IF( ln_zps ) CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv, & ! zps: before hor. gradient 131 & rhd, gru , grv ) ! of t,s,rd at ocean bottom 132 #endif 132 133 ! 133 134 ! - ML - sshn could be modified by istate_eel, so that initialization of fse3t_b is done here -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/lib_cray.f90
r1601 r2236 10 10 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 11 11 !!---------------------------------------------------------------------- 12 12 SUBROUTINE wheneq ( i, x, j, t, ind, nn ) 13 13 IMPLICIT NONE 14 14 … … 28 28 END DO 29 29 30 30 END SUBROUTINE wheneq -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/lib_mpp.F90
r2004 r2236 71 71 PUBLIC mpprecv, mppsend, mppscatter, mppgather 72 72 PUBLIC mppobc, mpp_ini_ice, mpp_ini_znl 73 #if defined key_oasis3 || defined key_oasis474 73 PUBLIC mppsize, mpprank 75 #endif76 74 77 75 # if defined key_mpp_rep1 … … 176 174 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 177 175 !! $Id$ 178 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)176 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 179 177 !!---------------------------------------------------------------------- 180 178 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/oce.F90
r2148 r2236 48 48 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 49 49 !! $Id$ 50 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)50 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 51 51 !!====================================================================== 52 52 END MODULE oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/opa.F90
r2224 r2236 25 25 !! - ! 2007-07 (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 26 26 !! 3.2 ! 2009-08 (S. Masson) open/write in the listing file in mpp 27 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 27 !! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 28 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 28 29 !!---------------------------------------------------------------------- 29 30 … … 47 48 USE zdfini 48 49 USE phycst ! physical constant (par_cst routine) 50 USE trdmod ! momentum/tracers trends (trd_mod_init routine) 51 USE asminc ! assimilation increments (asm_inc_init routine) 52 USE asmtrj ! writing out state trajectory 53 USE sshwzv ! vertical velocity used in asm 54 USE diaptr ! poleward transports (dia_ptr_init routine) 55 USE diaobs ! Observation diagnostics (dia_obs_init routine) 49 56 USE step ! OPA time-stepping (stp routine) 50 57 #if defined key_oasis3 … … 53 60 USE cpl_oasis4 ! OASIS4 coupling (not working) 54 61 #endif 62 #if defined key_c1d 55 63 USE c1d ! 1D configuration 56 64 USE step_c1d ! Time stepping loop for the 1D configuration 65 #endif 57 66 #if defined key_top 58 67 USE trcini ! passive tracer initialisation … … 74 83 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 75 84 !! $Id$ 76 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)85 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 77 86 !!---------------------------------------------------------------------- 78 87 … … 114 123 ! !-----------------------! 115 124 istp = nit000 116 IF( lk_c1d ) THEN !== 1D configuration ==! 125 #if defined key_c1d 117 126 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 118 127 CALL stp_c1d( istp ) 119 128 istp = istp + 1 120 129 END DO 121 ELSE !== 3D ocean with ==! 130 #else 131 IF( lk_asminc ) THEN 132 IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 ) ! Output background fields 133 IF( ln_trjwri ) CALL asm_trj_wri( nit000 - 1 ) ! Output trajectory fields 134 IF( ln_asmdin ) THEN ! Direct initialization 135 IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 ) ! Tracers 136 IF( ln_dyninc ) THEN 137 CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics 138 IF ( ln_asmdin ) CALL ssh_wzv ( nit000 - 1 ) ! update vertical velocity 139 ENDIF 140 IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 ) ! SSH 141 ENDIF 142 ENDIF 143 122 144 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 123 145 #if defined key_agrif … … 129 151 IF( lk_mpp ) CALL mpp_max( nstop ) 130 152 END DO 131 ENDIF 153 #endif 154 155 IF( lk_diaobs ) CALL dia_obs_wri 132 156 133 157 ! !------------------------! … … 184 208 #else 185 209 # if defined key_oasis3 || defined key_oasis4 186 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 210 IF( Agrif_Root() ) THEN 211 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 212 ENDIF 187 213 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection (control print return in cltxt) 188 214 # else … … 222 248 ELSE ; CALL mpp_init2 ! eliminate land processors 223 249 ENDIF 250 !!gm c1d case can be moved in dom_init routine 251 #if defined key_c1d 252 CALL cor_c1d ! Coriolis defined at T-point 253 umask(:,:,:) = tmask(:,:,:) ! U, V and T-points are the same 254 vmask(:,:,:) = tmask(:,:,:) ! 255 #endif 256 !!gm c1d end 224 257 225 258 ! ! General initialization … … 282 315 CALL dia_hsb_init ! heat content, salt content and volume budgets 283 316 CALL trd_mod_init ! Mixed-layer/Vorticity/Integral constraints trends 317 IF( lk_diaobs ) THEN 318 CALL dia_obs_init ! Initialize observational data 319 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 320 ENDIF 321 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 322 IF(lwp) WRITE(numout,*)'Euler time step switch is ', neuler 323 284 324 ! 285 325 END SUBROUTINE opa_init -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/par_oce.F90
r2104 r2236 18 18 !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj 19 19 #if ! defined key_mpp_dyndist 20 INTEGER, PUBLIC, PARAMETER :: jpni = 1 !: number of processors following i 21 INTEGER, PUBLIC, PARAMETER :: jpnj = 1 !: number of processors following j 22 INTEGER, PUBLIC, PARAMETER :: jpnij = 1 !: nb of local domain = nb of processors ( <= jpni x jpnj ) 20 INTEGER, PUBLIC, PARAMETER :: & !: 21 # if ! defined key_nproci 22 jpni = 1, & !: number of processors following i 23 jpnj = 1, & !: number of processors following j 24 jpnij = 1 !: nb of local domain = nb of processors 25 ! ! ( <= jpni x jpnj ) 26 # else 27 jpni = key_nproci, & !: number of processors following i 28 jpnj = key_nprocj, & !: number of processors following j 29 # if ! defined key_nprocij 30 jpnij = key_nproci * key_nprocj !: nb of local domain = nb of processors 31 ! ! ( <= jpni x jpnj ) 32 # else 33 jpnij = key_nprocij !: nb of local domain = nb of processors 34 ! ! ( <= jpni x jpnj ) 35 # endif 36 # endif 23 37 #else 24 38 INTEGER, PUBLIC :: jpni !: number of processors following i -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/step.F90
r2200 r2236 21 21 !! 3.2 ! 2009-02 (G. Madec, R. Benshila) reintroduicing z*-coordinate 22 22 !! - ! 2009-06 (S. Masson, G. Madec) TKE restart compatible with key_cpl 23 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 23 !! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 24 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 24 25 !!---------------------------------------------------------------------- 25 26 … … 32 33 #endif 33 34 35 USE asminc ! assimilation increments (tra_asm_inc, dyn_asm_inc routines) 36 USE stpctl ! time stepping control (stp_ctl routine) 37 USE restart ! ocean restart (rst_wri routine) 38 USE prtctl ! Print control (prt_ctl routine) 39 40 #if defined key_agrif 41 USE agrif_opa_sponge ! Momemtum and tracers sponges 42 #endif 43 34 44 IMPLICIT NONE 35 45 PRIVATE … … 43 53 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 44 54 !! $Id$ 45 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)55 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 46 56 !!---------------------------------------------------------------------- 47 57 … … 112 122 IF( lk_zdftke_old ) CALL zdf_tke_old( kstp ) ! TKE closure scheme for Kz (old scheme) 113 123 IF( lk_zdftke ) CALL zdf_tke ( kstp ) ! TKE closure scheme for Kz 124 IF( lk_zdfgls ) CALL zdf_gls ( kstp ) ! GLS closure scheme for Kz 114 125 IF( lk_zdfkpp ) CALL zdf_kpp ( kstp ) ! KPP closure scheme for Kz 115 126 IF( lk_zdfcst ) THEN ! Constant Kz (reset avt, avm[uv] to the background value) … … 131 142 ! write tke information in the restart file 132 143 IF( lrst_oce .AND. lk_zdftke ) CALL tke_rst( kstp, 'WRITE' ) 144 ! write gls information in the restart file 145 IF( lrst_oce .AND. lk_zdfgls ) CALL gls_rst( kstp, 'WRITE' ) 133 146 ! 134 147 ! LATERAL PHYSICS … … 138 151 IF( ln_zps ) CALL zps_hde( kstp, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient 139 152 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 153 IF ( .NOT. ln_traldf_grif ) THEN 140 154 CALL ldf_slp( kstp, rhd, rn2b ) ! before slope of the lateral mixing 155 ELSE 156 CALL ldf_slp_grif( kstp ) 157 IF ( ln_dynldf_bilap .OR. ln_dynldf_iso ) CALL ldf_slp( kstp, rhd, rn2b ) 158 ENDIF 141 159 ENDIF 142 160 #if defined key_traldf_c2d … … 152 170 IF( lk_diahdy ) CALL dia_hdy( kstp ) ! dynamical heigh diagnostics 153 171 IF( lk_diafwb ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 172 IF( lk_diaobs ) CALL dia_obs( kstp ) ! obs-minus-model (assimilation) diagnostics 154 173 IF( ln_diaptr ) CALL dia_ptr( kstp ) ! Poleward TRansports diagnostics 155 174 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag … … 168 187 tsa(:,:,:,:) = 0.e0 ! set tracer trends to zero 169 188 189 IF( ln_asmiau .AND. & 190 & ln_trainc ) CALL tra_asm_inc( kstp ) ! apply tracer assimilation increment 170 191 CALL tra_sbc ( kstp ) ! surface boundary condition 171 192 IF( ln_traqsr ) CALL tra_qsr ( kstp ) ! penetrative solar radiation qsr … … 206 227 va(:,:,:) = 0.e0 207 228 229 IF( ln_asmiau .AND. & 230 & ln_dyninc ) CALL dyn_asm_inc( kstp ) ! apply dynamics assimilation increment 208 231 CALL dyn_adv( kstp ) ! advection (vector or flux form) 209 232 CALL dyn_vor( kstp ) ! vorticity term including Coriolis -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/stpctl.F90
r1588 r2236 29 29 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 30 30 !! $Id$ 31 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)31 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 32 32 !!---------------------------------------------------------------------- 33 33 -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/trc_oce.F90
r2104 r2236 40 40 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 41 41 !! $Id$ 42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)42 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- 44 44
Note: See TracChangeset
for help on using the changeset viewer.