Changeset 3062 for branches/2011/dev_UKM0_2011
- Timestamp:
- 2011-11-09T11:47:32+01:00 (12 years ago)
- Location:
- branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 22 edited
- 14 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r2528 r3062 18 18 USE lib_mpp ! distributed memory computing library 19 19 USE trabbc ! bottom boundary condition 20 USE obc_par ! (for lk_obc) 20 21 USE bdy_par ! (for lk_bdy) 21 USE obc_par ! (for lk_obc)22 22 23 23 IMPLICIT NONE … … 205 205 WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 206 206 WRITE(numout,*) "~~~~~~~ output written in the 'heat_salt_volume_budgets.txt' ASCII file" 207 IF( lk_obc . OR. lk_bdy) THEN207 IF( lk_obc .or. lk_bdy ) THEN 208 208 CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' ) 209 209 ENDIF -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r2715 r3062 150 150 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .FALSE. !: fixed grid flag 151 151 #endif 152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur , hvr !: inverse of u and v-points ocean depth (1/m)153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu , hv !: depth at u- and v-points (meters)154 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: refernce depth at u- and v-points (meters)152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hur , hvr !: inverse of u and v-points ocean depth (1/m) 153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu , hv !: depth at u- and v-points (meters) 154 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: refernce depth at u- and v-points (meters) 155 155 156 156 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r2715 r3062 25 25 USE oce ! ocean dynamics and tracers 26 26 USE dom_oce ! ocean space and time domain 27 USE obc_oce ! ocean open boundary conditions28 27 USE in_out_manager ! I/O manager 29 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r2715 r3062 27 27 USE sbc_oce, ONLY : ln_rnf ! surface boundary condition: ocean 28 28 USE sbcrnf ! river runoff 29 USE obc_oce ! ocean lateral open boundary condition30 29 USE cla ! cross land advection (cla_div routine) 31 30 USE in_out_manager ! I/O manager … … 121 120 END DO 122 121 123 #if defined key_obc124 IF( Agrif_Root() ) THEN125 ! open boundaries (div must be zero behind the open boundary)126 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column127 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east128 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west129 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north130 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south131 ENDIF132 #endif133 122 IF( .NOT. AGRIF_Root() ) THEN 134 123 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east … … 304 293 END DO 305 294 306 #if defined key_obc307 IF( Agrif_Root() ) THEN308 ! open boundaries (div must be zero behind the open boundary)309 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column310 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east311 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west312 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north313 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south314 ENDIF315 #endif316 295 IF( .NOT. AGRIF_Root() ) THEN 317 296 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r2779 r3062 33 33 USE obcdyn_bt ! 2D open boundary condition for momentum (obc_dyn_bt routine) 34 34 USE obcvol ! ocean open boundary condition (obc_vol routines) 35 USE bdy_oce ! unstructured open boundary conditions 36 USE bdydta ! unstructured open boundary conditions 37 USE bdydyn ! unstructured open boundary conditions 35 USE bdy_oce ! ocean open boundary conditions 36 USE bdydta ! ocean open boundary conditions 37 USE bdydyn ! ocean open boundary conditions 38 USE bdyvol ! ocean open boundary condition (bdy_vol routines) 38 39 USE in_out_manager ! I/O manager 39 40 USE lbclnk ! lateral boundary condition (or mpp link) … … 77 78 !! * Apply lateral boundary conditions on after velocity 78 79 !! at the local domain boundaries through lbc_lnk call, 79 !! at the radiative open boundaries (lk_obc=T), 80 !! at the relaxed open boundaries (lk_bdy=T), and 80 !! at the one-way open boundaries (lk_obc=T), 81 81 !! at the AGRIF zoom boundaries (lk_agrif=T) 82 82 !! … … 174 174 ENDIF 175 175 ! 176 # elif defined key_bdy 176 # elif defined key_bdy 177 177 ! !* BDY open boundaries 178 IF( .NOT. lk_dynspg_flt ) THEN 179 CALL bdy_dyn_frs( kt ) 180 # if ! defined key_vvl 181 ua_e(:,:) = 0.e0 182 va_e(:,:) = 0.e0 183 ! Set these variables for use in bdy_dyn_fla 184 hur_e(:,:) = hur(:,:) 185 hvr_e(:,:) = hvr(:,:) 186 DO jk = 1, jpkm1 !! Vertically integrated momentum trends 187 ua_e(:,:) = ua_e(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 188 va_e(:,:) = va_e(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 189 END DO 190 ua_e(:,:) = ua_e(:,:) * hur(:,:) 191 va_e(:,:) = va_e(:,:) * hvr(:,:) 192 DO jk = 1 , jpkm1 193 ua(:,:,jk) = ua(:,:,jk) - ua_e(:,:) 194 va(:,:,jk) = va(:,:,jk) - va_e(:,:) 195 END DO 196 CALL bdy_dta_fla( kt+1, 0,2*nn_baro) 197 CALL bdy_dyn_fla( sshn_b ) 198 CALL lbc_lnk( ua_e, 'U', -1. ) ! Boundary points should be updated 199 CALL lbc_lnk( va_e, 'V', -1. ) ! 200 DO jk = 1 , jpkm1 201 ua(:,:,jk) = ( ua(:,:,jk) + ua_e(:,:) ) * umask(:,:,jk) 202 va(:,:,jk) = ( va(:,:,jk) + va_e(:,:) ) * vmask(:,:,jk) 203 END DO 204 # endif 205 ENDIF 178 IF( lk_dynspg_exp ) CALL bdy_dyn( kt ) 179 IF( lk_dynspg_ts ) CALL bdy_dyn( kt, dyn3d_only=.true. ) 180 181 !!$ Do we need a call to bdy_vol here?? 182 ! 206 183 # endif 207 184 ! -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r2715 r3062 15 15 USE dom_oce ! ocean space and time domain variables 16 16 USE phycst ! physical constants 17 USE obc_oce ! ocean open boundary conditions18 17 USE sbc_oce ! surface boundary condition: ocean 19 18 USE sbcapr ! surface boundary condition: atmospheric pressure … … 222 221 ENDIF 223 222 224 #if defined key_obc225 ! ! Conservation of ocean volume (key_dynspg_flt)226 IF( lk_dynspg_flt ) ln_vol_cst = .true.227 228 ! ! Application of Flather's algorithm at open boundaries229 IF( lk_dynspg_flt ) ln_obc_fla = .false.230 IF( lk_dynspg_exp ) ln_obc_fla = .true.231 IF( lk_dynspg_ts ) ln_obc_fla = .true.232 #endif233 223 ! 234 224 END SUBROUTINE dyn_spg_init -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r2715 r3062 21 21 USE phycst ! physical constants 22 22 USE obc_par ! open boundary condition parameters 23 USE obcdta ! open boundary condition data ( obc_dta_bt routine)23 USE obcdta ! open boundary condition data (bdy_dta_bt routine) 24 24 USE in_out_manager ! I/O manager 25 25 USE lib_mpp ! distributed memory computing library -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r2715 r3062 26 26 USE sbc_oce ! surface boundary condition: ocean 27 27 USE obc_oce ! Lateral open boundary condition 28 USE bdy_oce ! Lateral open boundary condition 28 29 USE sol_oce ! ocean elliptic solver 29 30 USE phycst ! physical constants … … 33 34 USE solpcg ! preconditionned conjugate gradient solver 34 35 USE solsor ! Successive Over-relaxation solver 35 USE obcdyn ! ocean open boundary condition (obc_dyn routines) 36 USE obcvol ! ocean open boundary condition (obc_vol routines) 37 USE bdy_oce ! Unstructured open boundaries condition 38 USE bdydyn ! Unstructured open boundaries condition (bdy_dyn routine) 39 USE bdyvol ! Unstructured open boundaries condition (bdy_vol routine) 36 USE obcdyn ! ocean open boundary condition on dynamics 37 USE obcvol ! ocean open boundary condition (obc_vol routine) 38 USE bdydyn ! ocean open boundary condition on dynamics 39 USE bdyvol ! ocean open boundary condition (bdy_vol routine) 40 40 USE cla ! cross land advection 41 41 USE in_out_manager ! I/O manager … … 187 187 #endif 188 188 #if defined key_bdy 189 CALL bdy_dyn _frs( kt ) ! Update velocities on unstructured boundary using the Flow Relaxation Scheme190 CALL bdy_vol( kt ) 189 CALL bdy_dyn( kt ) ! Update velocities on each open boundary 190 CALL bdy_vol( kt ) ! Correction of the barotropic component velocity to control the volume of the system 191 191 #endif 192 192 #if defined key_agrif … … 304 304 #if defined key_obc 305 305 ! caution : grad D = 0 along open boundaries 306 ! Remark: The filtering force could be reduced here in the FRS zone 307 ! by multiplying spgu/spgv by (1-alpha) ?? 306 308 spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 307 309 spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 308 310 #elif defined key_bdy 309 311 ! caution : grad D = 0 along open boundaries 310 ! Remark: The filtering force could be reduced here in the FRS zone311 ! by multiplying spgu/spgv by (1-alpha) ??312 312 spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj) 313 spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj) 313 spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj) 314 314 #else 315 315 spgu(ji,jj) = z2dt * ztdgu -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
r2715 r3062 34 34 35 35 ! !!! Time splitting scheme (key_dynspg_ts) 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_e, ssha_e ! sea surface heigth (now, after, average)37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_e , va_e ! barotropic velocities (after)38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e , hv_e ! now ocean depth ( = Ho+sshn_e )39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur_e , hvr_e ! inverse of hu_e and hv_e40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_b! before field without time-filter36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshn_e, ssha_e ! sea surface heigth (now, after, average) 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: ua_e , va_e ! barotropic velocities (after) 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e , hv_e ! now ocean depth ( = Ho+sshn_e ) 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hur_e , hvr_e ! inverse of hu_e and hv_e 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshn_b ! before field without time-filter 41 41 42 42 !!---------------------------------------------------------------------- -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r2724 r3062 25 25 USE domvvl ! variable volume 26 26 USE zdfbfr ! bottom friction 27 USE obcdta ! open boundary condition data28 USE obcfla ! Flather open boundary condition29 27 USE dynvor ! vorticity term 30 28 USE obc_oce ! Lateral open boundary condition 31 29 USE obc_par ! open boundary condition parameters 32 USE bdy_oce ! unstructured open boundaries 33 USE bdy_par ! unstructured open boundaries 34 USE bdydta ! unstructured open boundaries 35 USE bdydyn ! unstructured open boundaries 36 USE bdytides ! tidal forcing at unstructured open boundaries. 30 USE obcdta ! open boundary condition data 31 USE obcfla ! Flather open boundary condition 32 USE bdy_par ! for lk_bdy 33 USE bdy_oce ! Lateral open boundary condition 34 USE bdydta ! open boundary condition data 35 USE bdydyn2d ! open boundary conditions on barotropic variables 37 36 USE lib_mpp ! distributed memory computing library 38 37 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 367 366 IF( jn == 1 ) z2dt_e = rdt / nn_baro 368 367 369 ! !* Update the forcing ( OBC,BDY and tides)368 ! !* Update the forcing (BDY and tides) 370 369 ! ! ------------------ 371 370 IF( lk_obc ) CALL obc_dta_bt ( kt, jn ) 372 IF( lk_bdy ) CALL bdy_dta _fla( kt, jn+1, icycle)371 IF( lk_bdy ) CALL bdy_dta ( kt, jit=jn, time_offset=+1 ) 373 372 374 373 ! !* after ssh_e … … 489 488 ! !* domain lateral boundary 490 489 ! ! ----------------------- 491 ! ! Flather's boundary condition for the barotropic loop : 492 ! ! - Update sea surface height on each open boundary 493 ! ! - Correct the velocity 494 490 491 ! OBC open boundaries 495 492 IF( lk_obc ) CALL obc_fla_ts ( ua_e, va_e, sshn_e, ssha_e ) 496 IF( lk_bdy .OR. ln_tides ) CALL bdy_dyn_fla( sshn_e ) 493 494 ! BDY open boundaries 495 #if defined key_bdy 496 pssh => sshn_e 497 phur => hur_e 498 phvr => hvr_e 499 pu2d => ua_e 500 pv2d => va_e 501 502 IF( lk_bdy ) CALL bdy_dyn2d( kt ) 503 #endif 504 497 505 ! 498 506 CALL lbc_lnk( ua_e , 'U', -1. ) ! local domain boundaries -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r2715 r3062 182 182 #if defined key_bdy 183 183 ssha(:,:) = ssha(:,:) * bdytmask(:,:) 184 CALL lbc_lnk( ssha, 'T', 1. ) 184 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm) 185 185 #endif 186 186 -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
r2715 r3062 345 345 ! more time. 346 346 # if defined key_obc 347 DO jfl = 1, jpnfl 348 IF( lp_obc_east ) THEN 349 IF( jped <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <= zgifl(jfl) ) THEN 350 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 351 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 352 zagefl(jfl) = rdt 353 END IF 354 END IF 355 IF( lp_obc_west ) THEN 356 IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >= zgifl(jfl) ) THEN 357 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 358 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 359 zagefl(jfl) = rdt 360 END IF 361 END IF 362 IF( lp_obc_north ) THEN 363 IF( jpnd <= zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >= zgjfl(jfl) ) THEN 364 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 365 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 366 zagefl(jfl) = rdt 367 END IF 368 END IF 369 IF( lp_obc_south ) THEN 370 IF( jpsd <= zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND. njsob >= zgjfl(jfl) ) THEN 371 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 372 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 373 zagefl(jfl) = rdt 374 END IF 375 END IF 376 END DO 347 !!!!!!!! NEED TO SORT THIS OUT !!!!!!!! 348 !!$ DO jfl = 1, jpnfl 349 !!$ IF( lp_obc_east ) THEN 350 !!$ IF( jped <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <= zgifl(jfl) ) THEN 351 !!$ zgifl (jfl) = INT(zgifl(jfl)) + 0.5 352 !!$ zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 353 !!$ zagefl(jfl) = rdt 354 !!$ END IF 355 !!$ END IF 356 !!$ IF( lp_obc_west ) THEN 357 !!$ IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >= zgifl(jfl) ) THEN 358 !!$ zgifl (jfl) = INT(zgifl(jfl)) + 0.5 359 !!$ zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 360 !!$ zagefl(jfl) = rdt 361 !!$ END IF 362 !!$ END IF 363 !!$ IF( lp_obc_north ) THEN 364 !!$ IF( jpnd <= zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >= zgjfl(jfl) ) THEN 365 !!$ zgifl (jfl) = INT(zgifl(jfl)) + 0.5 366 !!$ zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 367 !!$ zagefl(jfl) = rdt 368 !!$ END IF 369 !!$ END IF 370 !!$ IF( lp_obc_south ) THEN 371 !!$ IF( jpsd <= zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND. njsob >= zgjfl(jfl) ) THEN 372 !!$ zgifl (jfl) = INT(zgifl(jfl)) + 0.5 373 !!$ zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 374 !!$ zagefl(jfl) = rdt 375 !!$ END IF 376 !!$ END IF 377 !!$ END DO 377 378 #endif 378 379 -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r2731 r3062 47 47 !! mppsync : 48 48 !! mppstop : 49 !! mppobc : variant of mpp_lnk for open boundary condition50 49 !! mpp_ini_north : initialisation of north fold 51 50 !! mpp_lbc_north : north fold processors gathering … … 64 63 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 65 64 PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 66 PUBLIC mpp obc, mpp_ini_ice, mpp_ini_znl65 PUBLIC mpp_ini_ice, mpp_ini_znl 67 66 PUBLIC mppsize 68 67 PUBLIC lib_mpp_alloc ! Called in nemogcm.F90 … … 1726 1725 END SUBROUTINE mppstop 1727 1726 1728 1729 SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout)1730 !!----------------------------------------------------------------------1731 !! *** routine mppobc ***1732 !!1733 !! ** Purpose : Message passing manadgement for open boundary1734 !! conditions array1735 !!1736 !! ** Method : Use mppsend and mpprecv function for passing mask1737 !! between processors following neighboring subdomains.1738 !! domain parameters1739 !! nlci : first dimension of the local subdomain1740 !! nlcj : second dimension of the local subdomain1741 !! nbondi : mark for "east-west local boundary"1742 !! nbondj : mark for "north-south local boundary"1743 !! noea : number for local neighboring processors1744 !! nowe : number for local neighboring processors1745 !! noso : number for local neighboring processors1746 !! nono : number for local neighboring processors1747 !!1748 !!----------------------------------------------------------------------1749 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released1750 USE wrk_nemo, ONLY: ztab => wrk_2d_11751 !1752 INTEGER , INTENT(in ) :: kd1, kd2 ! starting and ending indices1753 INTEGER , INTENT(in ) :: kl ! index of open boundary1754 INTEGER , INTENT(in ) :: kk ! vertical dimension1755 INTEGER , INTENT(in ) :: ktype ! define north/south or east/west cdt1756 ! ! = 1 north/south ; = 2 east/west1757 INTEGER , INTENT(in ) :: kij ! horizontal dimension1758 INTEGER , INTENT(in ) :: kumout ! ocean.output logical unit1759 REAL(wp), INTENT(inout), DIMENSION(kij,kk) :: ptab ! variable array1760 !1761 INTEGER :: ji, jj, jk, jl ! dummy loop indices1762 INTEGER :: iipt0, iipt1, ilpt1 ! local integers1763 INTEGER :: ijpt0, ijpt1 ! - -1764 INTEGER :: imigr, iihom, ijhom ! - -1765 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend1766 INTEGER :: ml_stat(MPI_STATUS_SIZE) ! for key_mpi_isend1767 !!----------------------------------------------------------------------1768 1769 IF( wrk_in_use(2, 1) ) THEN1770 WRITE(kumout, cform_err)1771 WRITE(kumout,*) 'mppobc : requested workspace array unavailable'1772 CALL mppstop1773 ENDIF1774 1775 ! boundary condition initialization1776 ! ---------------------------------1777 ztab(:,:) = 0.e01778 !1779 IF( ktype==1 ) THEN ! north/south boundaries1780 iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci ) )1781 iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) )1782 ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci ) )1783 ijpt0 = MAX( 1, MIN(kl - njmpp+1, nlcj ) )1784 ijpt1 = MAX( 0, MIN(kl - njmpp+1, nlcj - 1 ) )1785 ELSEIF( ktype==2 ) THEN ! east/west boundaries1786 iipt0 = MAX( 1, MIN(kl - nimpp+1, nlci ) )1787 iipt1 = MAX( 0, MIN(kl - nimpp+1, nlci - 1 ) )1788 ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj ) )1789 ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) )1790 ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj ) )1791 ELSE1792 WRITE(kumout, cform_err)1793 WRITE(kumout,*) 'mppobc : bad ktype'1794 CALL mppstop1795 ENDIF1796 1797 ! Communication level by level1798 ! ----------------------------1799 !!gm Remark : this is very time consumming!!!1800 ! ! ------------------------ !1801 DO jk = 1, kk ! Loop over the levels !1802 ! ! ------------------------ !1803 !1804 IF( ktype == 1 ) THEN ! north/south boundaries1805 DO jj = ijpt0, ijpt11806 DO ji = iipt0, iipt11807 ztab(ji,jj) = ptab(ji,jk)1808 END DO1809 END DO1810 ELSEIF( ktype == 2 ) THEN ! east/west boundaries1811 DO jj = ijpt0, ijpt11812 DO ji = iipt0, iipt11813 ztab(ji,jj) = ptab(jj,jk)1814 END DO1815 END DO1816 ENDIF1817 1818 1819 ! 1. East and west directions1820 ! ---------------------------1821 !1822 IF( nbondi /= 2 ) THEN ! Read Dirichlet lateral conditions1823 iihom = nlci-nreci1824 DO jl = 1, jpreci1825 t2ew(:,jl,1) = ztab(jpreci+jl,:)1826 t2we(:,jl,1) = ztab(iihom +jl,:)1827 END DO1828 ENDIF1829 !1830 ! ! Migrations1831 imigr=jpreci*jpj1832 !1833 IF( nbondi == -1 ) THEN1834 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )1835 CALL mpprecv( 1, t2ew(1,1,2), imigr )1836 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )1837 ELSEIF( nbondi == 0 ) THEN1838 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )1839 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )1840 CALL mpprecv( 1, t2ew(1,1,2), imigr )1841 CALL mpprecv( 2, t2we(1,1,2), imigr )1842 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )1843 IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err )1844 ELSEIF( nbondi == 1 ) THEN1845 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )1846 CALL mpprecv( 2, t2we(1,1,2), imigr )1847 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )1848 ENDIF1849 !1850 ! ! Write Dirichlet lateral conditions1851 iihom = nlci-jpreci1852 !1853 IF( nbondi == 0 .OR. nbondi == 1 ) THEN1854 DO jl = 1, jpreci1855 ztab(jl,:) = t2we(:,jl,2)1856 END DO1857 ENDIF1858 IF( nbondi == -1 .OR. nbondi == 0 ) THEN1859 DO jl = 1, jpreci1860 ztab(iihom+jl,:) = t2ew(:,jl,2)1861 END DO1862 ENDIF1863 1864 1865 ! 2. North and south directions1866 ! -----------------------------1867 !1868 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions1869 ijhom = nlcj-nrecj1870 DO jl = 1, jprecj1871 t2sn(:,jl,1) = ztab(:,ijhom +jl)1872 t2ns(:,jl,1) = ztab(:,jprecj+jl)1873 END DO1874 ENDIF1875 !1876 ! ! Migrations1877 imigr = jprecj * jpi1878 !1879 IF( nbondj == -1 ) THEN1880 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )1881 CALL mpprecv( 3, t2ns(1,1,2), imigr )1882 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )1883 ELSEIF( nbondj == 0 ) THEN1884 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )1885 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )1886 CALL mpprecv( 3, t2ns(1,1,2), imigr )1887 CALL mpprecv( 4, t2sn(1,1,2), imigr )1888 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err )1889 IF( l_isend ) CALL mpi_wait( ml_req2, ml_stat, ml_err )1890 ELSEIF( nbondj == 1 ) THEN1891 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )1892 CALL mpprecv( 4, t2sn(1,1,2), imigr)1893 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err )1894 ENDIF1895 !1896 ! ! Write Dirichlet lateral conditions1897 ijhom = nlcj - jprecj1898 IF( nbondj == 0 .OR. nbondj == 1 ) THEN1899 DO jl = 1, jprecj1900 ztab(:,jl) = t2sn(:,jl,2)1901 END DO1902 ENDIF1903 IF( nbondj == 0 .OR. nbondj == -1 ) THEN1904 DO jl = 1, jprecj1905 ztab(:,ijhom+jl) = t2ns(:,jl,2)1906 END DO1907 ENDIF1908 IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN1909 DO jj = ijpt0, ijpt1 ! north/south boundaries1910 DO ji = iipt0,ilpt11911 ptab(ji,jk) = ztab(ji,jj)1912 END DO1913 END DO1914 ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN1915 DO jj = ijpt0, ilpt1 ! east/west boundaries1916 DO ji = iipt0,iipt11917 ptab(jj,jk) = ztab(ji,jj)1918 END DO1919 END DO1920 ENDIF1921 !1922 END DO1923 !1924 IF( wrk_not_released(2, 1) ) THEN1925 WRITE(kumout, cform_err)1926 WRITE(kumout,*) 'mppobc : failed to release workspace array'1927 CALL mppstop1928 ENDIF1929 !1930 END SUBROUTINE mppobc1931 1932 1933 1727 SUBROUTINE mpp_comm_free( kcom ) 1934 1728 !!---------------------------------------------------------------------- … … 2488 2282 MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 2489 2283 END INTERFACE 2490 INTERFACE mppobc2491 MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d2492 END INTERFACE2493 2284 INTERFACE mpp_minloc 2494 2285 MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d … … 2603 2394 WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom 2604 2395 END SUBROUTINE mppmin_int 2605 2606 SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij, knum )2607 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum2608 REAL, DIMENSION(:) :: parr ! variable array2609 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij, knum2610 END SUBROUTINE mppobc_1d2611 2612 SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij, knum )2613 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum2614 REAL, DIMENSION(:,:) :: parr ! variable array2615 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij, knum2616 END SUBROUTINE mppobc_2d2617 2618 SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij, knum )2619 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum2620 REAL, DIMENSION(:,:,:) :: parr ! variable array2621 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij, knum2622 END SUBROUTINE mppobc_3d2623 2624 SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij, knum )2625 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum2626 REAL, DIMENSION(:,:,:,:) :: parr ! variable array2627 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij, knum2628 END SUBROUTINE mppobc_4d2629 2396 2630 2397 SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj ) -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r2777 r3062 24 24 IMPLICIT NONE 25 25 PRIVATE 26 27 PUBLIC fld_map ! routine called by tides_init 26 28 27 29 TYPE, PUBLIC :: FLD_N !: Namelist field informations … … 56 58 LOGICAL :: rotn ! flag to indicate whether field has been rotated 57 59 END TYPE FLD 60 61 TYPE, PUBLIC :: MAP_POINTER !: Array of integer pointers to 1D arrays 62 INTEGER, POINTER :: ptr(:) 63 END TYPE MAP_POINTER 58 64 59 65 !$AGRIF_DO_NOT_TREAT … … 98 104 CONTAINS 99 105 100 SUBROUTINE fld_read( kt, kn_fsbc, sd )106 SUBROUTINE fld_read( kt, kn_fsbc, sd, map, jit, time_offset ) 101 107 !!--------------------------------------------------------------------- 102 108 !! *** ROUTINE fld_read *** … … 113 119 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 114 120 TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables 121 TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping index 122 INTEGER , INTENT(in ), OPTIONAL :: jit ! subcycle timestep for timesplitting option 123 INTEGER , INTENT(in ), OPTIONAL :: time_offset ! provide fields at time other than "now" 124 ! time_offset = -1 => fields at "before" time level 125 ! time_offset = +1 => fields at "after" time levels 126 ! etc. 115 127 !! 116 128 INTEGER :: imf ! size of the structure sd … … 119 131 INTEGER :: isecend ! number of second since Jan. 1st 00h of nit000 year at nitend 120 132 INTEGER :: isecsbc ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 133 INTEGER :: time_add ! local time_offset variable 121 134 LOGICAL :: llnxtyr ! open next year file? 122 135 LOGICAL :: llnxtmth ! open next month file? 123 136 LOGICAL :: llstop ! stop is the file does not exist 137 LOGICAL :: ll_firstcall ! true if this is the first call to fld_read for this set of fields 124 138 REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation 125 139 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation 126 140 CHARACTER(LEN=1000) :: clfmt ! write format 127 141 !!--------------------------------------------------------------------- 142 ll_firstcall = .false. 143 IF( PRESENT(jit) ) THEN 144 IF(kt == nit000 .and. jit == 1) ll_firstcall = .true. 145 ELSE 146 IF(kt == nit000) ll_firstcall = .true. 147 ENDIF 148 149 time_add = 0 150 IF( PRESENT(time_offset) ) THEN 151 time_add = time_offset 152 ENDIF 153 128 154 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 129 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) ! middle of sbc time step 155 IF( present(jit) ) THEN 156 ! ignore kn_fsbc in this case 157 isecsbc = nsec_year + nsec1jan000 + (jit+time_add)*rdt/REAL(nn_baro,wp) 158 ELSE 159 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + time_add * rdttra(1) ! middle of sbc time step 160 ENDIF 130 161 imf = SIZE( sd ) 131 162 ! 132 IF( kt == nit000 ) THEN ! initialization 133 DO jf = 1, imf 134 CALL fld_init( kn_fsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped) 135 END DO 163 IF( ll_firstcall ) THEN ! initialization 164 IF( PRESENT(map) ) THEN 165 DO jf = 1, imf 166 CALL fld_init( kn_fsbc, sd(jf), map(jf)%ptr ) ! read each before field (put them in after as they will be swapped) 167 END DO 168 ELSE 169 DO jf = 1, imf 170 CALL fld_init( kn_fsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped) 171 END DO 172 ENDIF 136 173 IF( lwp ) CALL wgt_print() ! control print 137 174 CALL fld_rot( kt, sd ) ! rotate vector fiels if needed … … 143 180 DO jf = 1, imf ! --- loop over field --- ! 144 181 145 IF( isecsbc > sd(jf)%nrec_a(2) .OR. kt == nit000) THEN ! read/update the after data?182 IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN ! read/update the after data? 146 183 147 184 IF( sd(jf)%ln_tint ) THEN ! swap before record field and informations … … 151 188 ENDIF 152 189 153 CALL fld_rec( kn_fsbc, sd(jf) ) ! update record informations 190 IF( PRESENT(jit) ) THEN 191 CALL fld_rec( kn_fsbc, sd(jf), jit=jit ) ! update record informations 192 ELSE 193 CALL fld_rec( kn_fsbc, sd(jf) ) ! update record informations 194 ENDIF 154 195 155 196 ! do we have to change the year/month/week/day of the forcing field?? … … 212 253 213 254 ! read after data 214 CALL fld_get( sd(jf) ) 255 IF( PRESENT(map) ) THEN 256 CALL fld_get( sd(jf), map(jf)%ptr ) 257 ELSE 258 CALL fld_get( sd(jf) ) 259 ENDIF 215 260 216 261 ENDIF … … 225 270 clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // & 226 271 & "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')" 227 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 272 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 228 273 & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 274 WRITE(numout, *) 'time_add is : ',time_add 229 275 ENDIF 230 276 ! temporal interpolation weights … … 253 299 254 300 255 SUBROUTINE fld_init( kn_fsbc, sdjf )301 SUBROUTINE fld_init( kn_fsbc, sdjf, map ) 256 302 !!--------------------------------------------------------------------- 257 303 !! *** ROUTINE fld_init *** … … 262 308 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 263 309 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 310 INTEGER , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 264 311 !! 265 312 LOGICAL :: llprevyr ! are we reading previous year file? … … 364 411 365 412 ! read before data 366 CALL fld_get( sdjf ) ! read before values in after arrays(as we will swap it later) 413 IF( PRESENT(map) ) THEN 414 CALL fld_get( sdjf, map ) ! read before values in after arrays(as we will swap it later) 415 ELSE 416 CALL fld_get( sdjf ) ! read before values in after arrays(as we will swap it later) 417 ENDIF 367 418 368 419 clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" … … 396 447 397 448 398 SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore )449 SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit ) 399 450 !!--------------------------------------------------------------------- 400 451 !! *** ROUTINE fld_rec *** … … 410 461 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 411 462 LOGICAL , INTENT(in ), OPTIONAL :: ldbefore ! sent back before record values (default = .FALSE.) 463 INTEGER , INTENT(in ), OPTIONAL :: jit ! index of barotropic subcycle 412 464 ! used only if sdjf%ln_tint = .TRUE. 413 465 !! … … 443 495 ! 444 496 ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 497 IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 445 498 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 446 499 ! swap at the middle of the year … … 471 524 ! 472 525 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 526 IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 473 527 imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 474 528 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) … … 498 552 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1) ! shift time to be centrered in the middle of sbc time step 499 553 ztmp = ztmp + 0.01 * rdttra(1) ! add 0.01 time step to avoid truncation error 554 IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 500 555 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 501 556 ! … … 546 601 547 602 548 SUBROUTINE fld_get( sdjf )549 !!--------------------------------------------------------------------- 550 !! *** ROUTINE fld_ clopn***603 SUBROUTINE fld_get( sdjf, map ) 604 !!--------------------------------------------------------------------- 605 !! *** ROUTINE fld_get *** 551 606 !! 552 607 !! ** Purpose : read the data 553 608 !!---------------------------------------------------------------------- 554 609 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 610 INTEGER , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 555 611 !! 556 612 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) … … 559 615 560 616 ipk = SIZE( sdjf%fnow, 3 ) 561 IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 617 618 IF( PRESENT(map) ) THEN 619 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) 620 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), map ) 621 ENDIF 622 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 562 623 CALL wgt_list( sdjf, iw ) 563 624 IF( sdjf%ln_tint ) THEN ; CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) … … 581 642 END SUBROUTINE fld_get 582 643 644 SUBROUTINE fld_map( num, clvar, dta, nrec, map ) 645 !!--------------------------------------------------------------------- 646 !! *** ROUTINE fld_get *** 647 !! 648 !! ** Purpose : read global data from file and map onto local data 649 !! using a general mapping (for open boundaries) 650 !!---------------------------------------------------------------------- 651 #if defined key_bdy 652 USE bdy_oce, ONLY: dta_global ! workspace to read in global data arrays 653 #endif 654 655 INTEGER , INTENT(in ) :: num ! stream number 656 CHARACTER(LEN=*) , INTENT(in ) :: clvar ! variable name 657 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: dta ! output field on model grid (2 dimensional) 658 INTEGER , INTENT(in ) :: nrec ! record number to read (ie time slice) 659 INTEGER, DIMENSION(:) , INTENT(in ) :: map ! global-to-local mapping indices 660 !! 661 INTEGER :: ipi ! length of boundary data on local process 662 INTEGER :: ipj ! length of dummy dimension ( = 1 ) 663 INTEGER :: ipk ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk ) 664 INTEGER :: ilendta ! length of data in file 665 INTEGER :: idvar ! variable ID 666 INTEGER :: ib, ik ! loop counters 667 INTEGER :: ierr 668 REAL(wp), POINTER, DIMENSION(:,:,:) :: dta_read ! work space for global data 669 !!--------------------------------------------------------------------- 670 671 #if defined key_bdy 672 dta_read => dta_global 673 #endif 674 675 ipi = SIZE( dta, 1 ) 676 ipj = 1 677 ipk = SIZE( dta, 3 ) 678 679 idvar = iom_varid( num, clvar ) 680 ilendta = iom_file(num)%dimsz(1,idvar) 681 IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta 682 IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk 683 684 SELECT CASE( ipk ) 685 CASE(1) 686 CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1 ), nrec ) 687 CASE DEFAULT 688 CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec ) 689 END SELECT 690 ! 691 DO ib = 1, ipi 692 DO ik = 1, ipk 693 dta(ib,1,ik) = dta_read(map(ib),1,ik) 694 END DO 695 END DO 696 697 END SUBROUTINE fld_map 698 583 699 584 700 SUBROUTINE fld_rot( kt, sd ) 585 701 !!--------------------------------------------------------------------- 586 !! *** ROUTINE fld_ clopn***702 !! *** ROUTINE fld_rot *** 587 703 !! 588 704 !! ** Purpose : Vector fields may need to be rotated onto the local grid direction 589 705 !!---------------------------------------------------------------------- 590 706 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 591 USE wrk_nemo, ONLY: utmp => wrk_2d_ 4, vtmp => wrk_2d_5 ! 2D workspace707 USE wrk_nemo, ONLY: utmp => wrk_2d_24, vtmp => wrk_2d_25 ! 2D workspace 592 708 !! 593 709 INTEGER , INTENT(in ) :: kt ! ocean time step … … 601 717 !!--------------------------------------------------------------------- 602 718 603 IF(wrk_in_use(2, 4,5) ) THEN719 IF(wrk_in_use(2, 24,25) ) THEN 604 720 CALL ctl_stop('fld_rot: ERROR: requested workspace arrays are unavailable.') ; RETURN 605 721 END IF … … 638 754 END DO 639 755 ! 640 IF(wrk_not_released(2, 4,5) ) CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.')756 IF(wrk_not_released(2, 24,25) ) CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.') 641 757 ! 642 758 END SUBROUTINE fld_rot … … 672 788 ! 673 789 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 674 790 ! 675 791 END SUBROUTINE fld_clopn 676 792 -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r2715 r3062 10 10 !! sbc_apr : read atmospheric pressure in netcdf files 11 11 !!---------------------------------------------------------------------- 12 USE bdy_par ! Unstructured boundary parameters13 12 USE obc_par ! open boundary condition parameters 14 13 USE dom_oce ! ocean space and time domain … … 30 29 ! !!* namsbc_apr namelist (Atmospheric PRessure) * 31 30 LOGICAL, PUBLIC :: ln_apr_obc = .FALSE. !: inverse barometer added to OBC ssh data 32 LOGICAL, PUBLIC :: ln_apr_bdy = .FALSE. !: inverse barometer added to BDY ssh data33 31 LOGICAL, PUBLIC :: ln_ref_apr = .FALSE. !: ref. pressure: global mean Patm (F) or a constant (F) 34 32 … … 115 113 ! 116 114 ! !* control check 117 IF( ln_apr_obc .OR. ln_apr_bdy) &118 CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC or BDYssh data not yet implemented ' )115 IF( ln_apr_obc ) & 116 CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC ssh data not yet implemented ' ) 119 117 IF( ln_apr_obc .AND. .NOT. lk_obc ) & 120 118 CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_obc' ) 121 IF( ln_apr_bdy .AND. .NOT. lk_bdy ) & 122 CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_bdy' ) 123 IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. lk_dynspg_ts ) & 119 IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts ) & 124 120 CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' ) 125 IF( ( ln_apr_obc .OR. ln_apr_bdy) .AND. .NOT. ln_apr_dyn ) &121 IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn ) & 126 122 CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 127 123 ENDIF -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r2715 r3062 38 38 USE sbcfwb ! surface boundary condition: freshwater budget 39 39 USE closea ! closed sea 40 USE bdy_par ! unstructured open boundary data variables41 USE bdyice ! unstructured open boundary data (bdy_ice_frsroutine)40 USE bdy_par ! for lk_bdy 41 USE bdyice_lim2 ! unstructured open boundary data (bdy_ice_lim_2 routine) 42 42 43 43 USE prtctl ! Print control (prt_ctl routine) … … 253 253 ! 254 254 CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM-2 ice model 255 IF( lk_bdy ) CALL bdy_ice_ frs( kt ) ! BDY boundary condition255 IF( lk_bdy ) CALL bdy_ice_lim_2( kt ) ! BDY boundary condition 256 256 ! 257 257 CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc ) ! LIM-3 ice model -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90
r2715 r3062 23 23 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 24 24 USE solmat ! matrix of the solver 25 USE obc_oce ! Lateral open boundary condition26 25 USE in_out_manager ! I/O manager 27 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r2715 r3062 36 36 USE obc_oce 37 37 USE obctra ! open boundary condition (obc_tra routine) 38 USE bdy_ par ! Unstructured open boundary condition (bdy_tra_frs routine)39 USE bdytra ! Unstructured open boundary condition (bdy_tra_frsroutine)38 USE bdy_oce 39 USE bdytra ! open boundary condition (bdy_tra routine) 40 40 USE in_out_manager ! I/O manager 41 41 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 43 43 USE traqsr ! penetrative solar radiation (needed for nksr) 44 44 USE traswp ! swap array 45 USE obc_oce46 45 #if defined key_agrif 47 46 USE agrif_opa_update … … 81 80 !! - Apply lateral boundary conditions on (ta,sa) 82 81 !! at the local domain boundaries through lbc_lnk call, 83 !! at the radiative open boundaries (lk_obc=T), 84 !! at the relaxed open boundaries (lk_bdy=T), and 82 !! at the one-way open boundaries (lk_obc=T), 85 83 !! at the AGRIF zoom boundaries (lk_agrif=T) 86 84 !! … … 119 117 #endif 120 118 #if defined key_bdy 121 IF( lk_bdy ) CALL bdy_tra _frs( kt ) ! BDY open boundaries119 IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries 122 120 #endif 123 121 #if defined key_agrif -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r2715 r3062 46 46 USE domain ! domain initialization (dom_init routine) 47 47 USE obcini ! open boundary cond. initialization (obc_ini routine) 48 USE bdyini ! unstructured open boundary cond. initialization (bdy_init routine) 48 USE bdyini ! open boundary cond. initialization (bdy_init routine) 49 USE bdydta ! open boundary cond. initialization (bdy_dta_init routine) 50 USE bdytides ! open boundary cond. initialization (tide_init routine) 49 51 USE istate ! initial state setting (istate_init routine) 50 52 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) … … 295 297 296 298 IF( lk_obc ) CALL obc_init ! Open boundaries 297 IF( lk_bdy ) CALL bdy_init ! Unstructured open boundaries 299 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 300 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays 301 IF( lk_bdy ) CALL tide_init ! Open boundaries initialisation of tidal harmonic forcing 298 302 299 303 CALL istate_init ! ocean initial state (Dynamics and tracers) -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/oce.F90
r2715 r3062 35 35 !! free surface ! before ! now ! after ! 36 36 !! ------------ ! fields ! fields ! trends ! 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshb , sshn , ssha !: sea surface height at t-point [m]38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m]39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m]40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshf_n !: sea surface height at f-point [m]37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshb , sshn , ssha !: sea surface height at t-point [m] 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m] 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m] 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshf_n !: sea surface height at f-point [m] 41 41 ! 42 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: spgu, spgv !: horizontal surface pressure gradient -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/step.F90
r2715 r3062 99 99 IF( lk_obc ) CALL obc_dta( kstp ) ! update dynamic and tracer data at open boundaries 100 100 IF( lk_obc ) CALL obc_rad( kstp ) ! compute phase velocities at open boundaries 101 IF( lk_bdy ) CALL bdy_dta _frs( kstp ) ! update dynamic and tracer data for FRS conditions (BDY)101 IF( lk_bdy ) CALL bdy_dta( kstp, time_offset=+1 ) ! update dynamic and tracer data at open boundaries 102 102 103 103 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -
branches/2011/dev_UKM0_2011/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r2528 r3062 53 53 USE obcrad ! open boundary cond. radiation (obc_rad routine) 54 54 55 USE bdy_par ! unstructured open boundary data variables56 USE bdydta ! unstructured open boundary data(bdy_dta routine)55 USE bdy_par ! for lk_bdy 56 USE bdydta ! open boundary condition data (bdy_dta routine) 57 57 58 58 USE sshwzv ! vertical velocity and ssh (ssh_wzv routine)
Note: See TracChangeset
for help on using the changeset viewer.