Changeset 4015
- Timestamp:
- 2013-09-09T12:13:17+02:00 (11 years ago)
- Location:
- branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 7 added
- 21 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r3851 r4015 10 10 !! 3.5 ! 2012 (S. Mocavero, I. Epicoco) Add arrays associated 11 11 !! to the optimization of BDY communications 12 !! 3.6 ! 2013 ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs 12 13 !!---------------------------------------------------------------------- 13 14 … … 42 43 INTEGER , PUBLIC :: nn_baro = 64 !: number of barotropic time steps (key_dynspg_ts) 43 44 INTEGER , PUBLIC :: nn_closea = 0 !: =0 suppress closed sea/lake from the ORCA domain or not (=1) 45 LOGICAL , PUBLIC :: ln_crs = .FALSE. !: Apply grid coarsening to dynamical model output or online passive tracers 44 46 45 47 ! !! old non-DOCTOR names still used in the model … … 195 197 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts 196 198 197 REAL(wp), PUBLIC, DIMENSION(jpiglo) ::tpol, fpol !: north fold mask (jperio= 3 or 4)199 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tpol, fpol !: north fold mask (jperio= 3 or 4) 198 200 199 201 #if defined key_noslip_accurate … … 264 266 INTEGER FUNCTION dom_oce_alloc() 265 267 !!---------------------------------------------------------------------- 266 INTEGER, DIMENSION(1 1) :: ierr268 INTEGER, DIMENSION(12) :: ierr 267 269 !!---------------------------------------------------------------------- 268 270 ierr(:) = 0 … … 311 313 & vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(10) ) 312 314 315 ALLOCATE( tpol(jpiglo) , fpol(jpiglo) , STAT=ierr(11) ) 316 313 317 #if defined key_noslip_accurate 314 ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(1 1) )318 ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(12) ) 315 319 #endif 316 320 ! -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r3764 r4015 12 12 !! 2.0 ! 2005-11 (V. Garnier) Surface pressure gradient organization 13 13 !! 3.3 ! 2010-11 (G. Madec) initialisation in C1D configuration 14 !! 3.6 ! 2013 ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs 14 15 !!---------------------------------------------------------------------- 15 16 … … 126 127 NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh , rn_hmin, & 127 128 & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , & 128 & rn_rdtmax, rn_rdth , nn_baro , nn_closea 129 & rn_rdtmax, rn_rdth , nn_baro , nn_closea , ln_crs 129 130 NAMELIST/namcla/ nn_cla 130 131 #if defined key_netcdf4 … … 202 203 REWIND( numnam ) ! Namelist namdom : space & time domain (bathymetry, mesh, timestep) 203 204 READ ( numnam, namdom ) 204 205 206 ! 205 207 IF(lwp) THEN 206 208 WRITE(numout,*) … … 216 218 WRITE(numout,*) ' = 2 mesh and mask ' 217 219 WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask' 218 WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt 219 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 220 WRITE(numout,*) ' time-splitting: nb of sub time-step nn_baro = ', nn_baro 221 WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc 222 WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin 223 WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax 224 WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth 225 WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea 220 WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt 221 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 222 WRITE(numout,*) ' time-splitting: nb of sub time-step nn_baro = ', nn_baro 223 WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc 224 WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin 225 WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax 226 WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth 227 WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea 228 WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs 226 229 ENDIF 227 230 -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r3940 r4015 37 37 # endif 38 38 USE ioipsl, ONLY : ju2ymds ! for calendar 39 USE crs ! Grid coarsening 39 40 40 41 IMPLICIT NONE … … 47 48 #endif 48 49 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 49 PUBLIC iom_getatt 50 PUBLIC iom_getatt, iom_context_finalize 50 51 51 52 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d … … 69 70 MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d 70 71 END INTERFACE 71 #if defined key_iomput72 INTERFACE iom_setkt73 MODULE PROCEDURE xios_update_calendar74 END INTERFACE75 # endif76 72 77 73 !!---------------------------------------------------------------------- … … 83 79 CONTAINS 84 80 85 SUBROUTINE iom_init 81 SUBROUTINE iom_init( cdname ) 86 82 !!---------------------------------------------------------------------- 87 83 !! *** ROUTINE *** … … 90 86 !! 91 87 !!---------------------------------------------------------------------- 88 CHARACTER(len=*), INTENT(in) :: cdname 92 89 #if defined key_iomput 93 90 TYPE(xios_time) :: dtime = xios_time(0, 0, 0, 0, 0, 0) … … 97 94 !!---------------------------------------------------------------------- 98 95 99 clname = "nemo"100 IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(c lname)96 clname = cdname 97 IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname) 101 98 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 102 CALL iom_swap 99 CALL iom_swap( cdname ) 103 100 104 101 ! calendar parameters … … 113 110 ! horizontal grid definition 114 111 CALL set_scalar 115 CALL set_grid( "T", glamt, gphit ) 116 CALL set_grid( "U", glamu, gphiu ) 117 CALL set_grid( "V", glamv, gphiv ) 118 CALL set_grid( "W", glamt, gphit ) 112 113 IF( TRIM(cdname) == "nemo" ) THEN 114 CALL set_grid( "T", glamt, gphit ) 115 CALL set_grid( "U", glamu, gphiu ) 116 CALL set_grid( "V", glamv, gphiv ) 117 CALL set_grid( "W", glamt, gphit ) 118 ENDIF 119 120 IF( TRIM(cdname) == "nemo_crs" ) THEN 121 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 122 ! 123 CALL set_grid( "T", glamt_crs, gphit_crs ) 124 CALL set_grid( "U", glamu_crs, gphiu_crs ) 125 CALL set_grid( "V", glamv_crs, gphiv_crs ) 126 CALL set_grid( "W", glamt_crs, gphit_crs ) 127 ! 128 CALL dom_grid_glo ! Return to parent grid domain 129 ENDIF 130 119 131 120 132 ! vertical grid definition … … 141 153 142 154 143 SUBROUTINE iom_swap 155 SUBROUTINE iom_swap( cdname ) 144 156 !!--------------------------------------------------------------------- 145 157 !! *** SUBROUTINE iom_swap *** … … 147 159 !! ** Purpose : swap context between different agrif grid for xmlio_server 148 160 !!--------------------------------------------------------------------- 161 CHARACTER(len=*), INTENT(in) :: cdname 149 162 #if defined key_iomput 150 163 TYPE(xios_context) :: nemo_hdl 151 164 152 IF( TRIM(Agrif_CFixed()) == '0' ) THEN153 CALL xios_get_handle( "nemo",nemo_hdl)154 ELSE155 CALL xios_get_handle(TRIM(Agrif_CFixed())//"_ nemo",nemo_hdl)156 ENDIF157 CALL xios_set_current_context(nemo_hdl)158 165 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 166 CALL xios_get_handle(TRIM(cdname),nemo_hdl) 167 ELSE 168 CALL xios_get_handle(TRIM(Agrif_CFixed())//"_"//TRIM(cdname),nemo_hdl) 169 ENDIF 170 ! 171 CALL xios_set_current_context(nemo_hdl) 159 172 #endif 173 ! 160 174 END SUBROUTINE iom_swap 161 175 … … 1100 1114 CALL xios_solve_inheritance() 1101 1115 END SUBROUTINE iom_set_grid_attr 1116 1117 SUBROUTINE iom_setkt( kt, cdname ) 1118 INTEGER , INTENT(in) :: kt 1119 CHARACTER(LEN=*), INTENT(in) :: cdname 1120 ! 1121 CALL iom_swap( cdname ) ! swap to cdname context 1122 CALL xios_update_calendar(kt) 1123 IF( cdname /= "nemo" ) CALL iom_swap( "nemo" ) ! return back to nemo context 1124 ! 1125 END SUBROUTINE iom_setkt 1126 1127 SUBROUTINE iom_context_finalize( cdname ) 1128 CHARACTER(LEN=*), INTENT(in) :: cdname 1129 ! 1130 CALL iom_swap( cdname ) ! swap to cdname context 1131 CALL xios_context_finalize() ! finalize the context 1132 IF( cdname /= "nemo" ) CALL iom_swap( "nemo" ) ! return back to nemo context 1133 ! 1134 END SUBROUTINE iom_context_finalize 1102 1135 1103 1136 … … 1424 1457 #else 1425 1458 1426 SUBROUTINE iom_setkt( kt ) 1427 INTEGER, INTENT(in ):: kt 1428 IF( .FALSE. ) WRITE(numout,*) kt ! useless test to avoid compilation warnings 1459 1460 SUBROUTINE iom_setkt( kt, cdname ) 1461 INTEGER , INTENT(in):: kt 1462 CHARACTER(LEN=*), INTENT(in) :: cdname 1463 IF( .FALSE. ) WRITE(numout,*) kt, cdname ! useless test to avoid compilation warnings 1429 1464 END SUBROUTINE iom_setkt 1465 1466 SUBROUTINE iom_context_finalize( cdname ) 1467 CHARACTER(LEN=*), INTENT(in) :: cdname 1468 IF( .FALSE. ) WRITE(numout,*) cdname ! useless test to avoid compilation warnings 1469 END SUBROUTINE iom_context_finalize 1430 1470 1431 1471 #endif -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r3768 r4015 264 264 END SELECT 265 265 ! ! North fold 266 pt3d( 1 ,jpj,:) = zland267 pt3d(jpi,jpj,:) = zland268 266 CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn ) 269 267 ! … … 386 384 END SELECT 387 385 ! ! North fold 388 pt2d( 1 ,1 ) = zland389 pt2d( 1 ,jpj) = zland390 pt2d(jpi,jpj) = zland391 386 CALL lbc_nfd( pt2d(:,:), cd_type, psgn ) 392 387 ! -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r3294 r4015 71 71 pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk) 72 72 END DO 73 pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-2,jk) 73 74 DO ji = jpiglo/2+1, jpiglo 74 75 ijt = jpiglo-ji+2 … … 80 81 pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk) 81 82 END DO 83 pt3d( 1 ,ijpj,jk) = psgn * pt3d( 2 ,ijpj-2,jk) 84 pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-2,jk) 82 85 DO ji = jpiglo/2, jpiglo-1 83 86 iju = jpiglo-ji+1 … … 90 93 pt3d(ji,ijpj ,jk) = psgn * pt3d(ijt,ijpj-3,jk) 91 94 END DO 95 pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-3,jk) 92 96 CASE ( 'F' ) ! F-point 93 97 DO ji = 1, jpiglo-1 … … 96 100 pt3d(ji,ijpj ,jk) = psgn * pt3d(iju,ijpj-3,jk) 97 101 END DO 102 pt3d( 1 ,ijpj,jk) = psgn * pt3d( 2 ,ijpj-3,jk) 103 pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-3,jk) 98 104 END SELECT 99 105 ! … … 111 117 pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk) 112 118 END DO 119 pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-1,jk) 113 120 CASE ( 'V' ) ! V-point 114 121 DO ji = 1, jpiglo … … 125 132 pt3d(ji,ijpj ,jk) = psgn * pt3d(iju,ijpj-2,jk) 126 133 END DO 134 pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-2,jk) 127 135 DO ji = jpiglo/2+1, jpiglo-1 128 136 iju = jpiglo-ji … … 199 207 END DO 200 208 END DO 209 pt2d(1,ijpj) = psgn * pt2d(3,ijpj-2) 201 210 DO ji = jpiglo/2+1, jpiglo 202 211 ijt=jpiglo-ji+2 … … 210 219 END DO 211 220 END DO 221 pt2d( 1 ,ijpj ) = psgn * pt2d( 2 ,ijpj-2) 222 pt2d(jpiglo,ijpj ) = psgn * pt2d(jpiglo-1,ijpj-2) 223 pt2d(1 ,ijpj-1) = psgn * pt2d(jpiglo ,ijpj-1) 212 224 DO ji = jpiglo/2, jpiglo-1 213 225 iju = jpiglo-ji+1 … … 221 233 END DO 222 234 END DO 235 pt2d( 1 ,ijpj) = psgn * pt2d( 3 ,ijpj-3) 223 236 CASE ( 'F' ) ! F-point 224 237 DO jl = -1, ipr2dj … … 228 241 END DO 229 242 END DO 243 pt2d( 1 ,ijpj) = psgn * pt2d( 2 ,ijpj-3) 244 pt2d(jpiglo,ijpj) = psgn * pt2d(jpiglo-1,ijpj-3) 245 pt2d(jpiglo,ijpj-1) = psgn * pt2d(jpiglo-1,ijpj-2) 246 pt2d( 1 ,ijpj-1) = psgn * pt2d( 2 ,ijpj-2) 230 247 CASE ( 'I' ) ! ice U-V point (I-point) 231 248 DO jl = 0, ipr2dj … … 271 288 END DO 272 289 END DO 290 pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-1) 273 291 CASE ( 'V' ) ! V-point 274 292 DO jl = 0, ipr2dj … … 289 307 END DO 290 308 END DO 309 pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-2) 291 310 DO ji = jpiglo/2+1, jpiglo-1 292 311 iju = jpiglo-ji -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3918 r4015 22 22 !! 'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update 23 23 !! the mppobc routine to optimize the BDY and OBC communications 24 !! 3.6 ! 2013 ( C. Ethe, G. Madec ) message passing arrays as local variables 24 25 !!---------------------------------------------------------------------- 25 26 … … 71 72 PUBLIC mppsize 72 73 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 73 PUBLIC lib_mpp_alloc ! Called in nemogcm.F9074 74 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 75 75 PUBLIC mpp_lnk_obc_2d, mpp_lnk_obc_3d … … 150 150 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend 151 151 152 ! message passing arrays153 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: t4ns, t4sn ! 2 x 3d for north-south & south-north154 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: t4ew, t4we ! 2 x 3d for east-west & west-east155 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: t4p1, t4p2 ! 2 x 3d for north fold156 REAL(wp), DIMENSION(:,:,:,:) , ALLOCATABLE, SAVE :: t3ns, t3sn ! 3d for north-south & south-north157 REAL(wp), DIMENSION(:,:,:,:) , ALLOCATABLE, SAVE :: t3ew, t3we ! 3d for east-west & west-east158 REAL(wp), DIMENSION(:,:,:,:) , ALLOCATABLE, SAVE :: t3p1, t3p2 ! 3d for north fold159 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2ns, t2sn ! 2d for north-south & south-north160 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2ew, t2we ! 2d for east-west & west-east161 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2p1, t2p2 ! 2d for north fold162 163 ! Arrays used in mpp_lbc_north_3d()164 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tab_3d, xnorthloc165 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: xnorthgloio166 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: foldwk ! Workspace for message transfers avoiding mpi_allgather167 168 ! Arrays used in mpp_lbc_north_2d()169 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_2d, xnorthloc_2d170 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_2d171 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: foldwk_2d ! Workspace for message transfers avoiding mpi_allgather172 173 ! Arrays used in mpp_lbc_north_e()174 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_e, xnorthloc_e175 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_e176 177 152 ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public 178 153 INTEGER, PUBLIC, PARAMETER :: jpmaxngh = 8 ! Assumed maximum number of active neighbours … … 189 164 !!---------------------------------------------------------------------- 190 165 CONTAINS 191 192 INTEGER FUNCTION lib_mpp_alloc( kumout )193 !!----------------------------------------------------------------------194 !! *** routine lib_mpp_alloc ***195 !!----------------------------------------------------------------------196 INTEGER, INTENT(in) :: kumout ! ocean.output logical unit197 !!----------------------------------------------------------------------198 !199 ALLOCATE( t4ns(jpi,jprecj,jpk,2,2) , t4sn(jpi,jprecj,jpk,2,2) , &200 & t4ew(jpj,jpreci,jpk,2,2) , t4we(jpj,jpreci,jpk,2,2) , &201 & t4p1(jpi,jprecj,jpk,2,2) , t4p2(jpi,jprecj,jpk,2,2) , &202 & t3ns(jpi,jprecj,jpk,2) , t3sn(jpi,jprecj,jpk,2) , &203 & t3ew(jpj,jpreci,jpk,2) , t3we(jpj,jpreci,jpk,2) , &204 & t3p1(jpi,jprecj,jpk,2) , t3p2(jpi,jprecj,jpk,2) , &205 & t2ns(jpi,jprecj ,2) , t2sn(jpi,jprecj ,2) , &206 & t2ew(jpj,jpreci ,2) , t2we(jpj,jpreci ,2) , &207 & t2p1(jpi,jprecj ,2) , t2p2(jpi,jprecj ,2) , &208 !209 & tab_3d(jpiglo,4,jpk) , xnorthloc(jpi,4,jpk) , xnorthgloio(jpi,4,jpk,jpni) , &210 & foldwk(jpi,4,jpk) , &211 !212 & tab_2d(jpiglo,4) , xnorthloc_2d(jpi,4) , xnorthgloio_2d(jpi,4,jpni) , &213 & foldwk_2d(jpi,4) , &214 !215 & tab_e(jpiglo,4+2*jpr2dj) , xnorthloc_e(jpi,4+2*jpr2dj) , xnorthgloio_e(jpi,4+2*jpr2dj,jpni) , &216 !217 & STAT=lib_mpp_alloc )218 !219 IF( lib_mpp_alloc /= 0 ) THEN220 WRITE(kumout,cform_war)221 WRITE(kumout,*) 'lib_mpp_alloc : failed to allocate arrays'222 ENDIF223 !224 END FUNCTION lib_mpp_alloc225 166 226 167 … … 385 326 REAL(wp) :: zland 386 327 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 387 !!---------------------------------------------------------------------- 328 ! 329 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 330 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 331 332 !!---------------------------------------------------------------------- 333 334 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), & 335 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 388 336 389 337 zland = 0.e0 ! zero by default … … 420 368 iihom = nlci-nreci 421 369 DO jl = 1, jpreci 422 t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)423 t3we(:,jl,:,1) = ptab(iihom +jl,:,:)370 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 371 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 424 372 END DO 425 373 END SELECT … … 430 378 SELECT CASE ( nbondi ) 431 379 CASE ( -1 ) 432 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )433 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )380 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 381 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 434 382 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 435 383 CASE ( 0 ) 436 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )437 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )438 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )439 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )384 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 385 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 386 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 387 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 440 388 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 441 389 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 442 390 CASE ( 1 ) 443 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )444 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )391 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 392 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 445 393 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 446 394 END SELECT … … 452 400 CASE ( -1 ) 453 401 DO jl = 1, jpreci 454 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)402 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 455 403 END DO 456 404 CASE ( 0 ) 457 405 DO jl = 1, jpreci 458 ptab(jl ,:,:) = t3we(:,jl,:,2)459 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)406 ptab(jl ,:,:) = zt3we(:,jl,:,2) 407 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 460 408 END DO 461 409 CASE ( 1 ) 462 410 DO jl = 1, jpreci 463 ptab(jl ,:,:) = t3we(:,jl,:,2)411 ptab(jl ,:,:) = zt3we(:,jl,:,2) 464 412 END DO 465 413 END SELECT … … 475 423 ijhom = nlcj-nrecj 476 424 DO jl = 1, jprecj 477 t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)478 t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)425 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 426 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 479 427 END DO 480 428 ENDIF … … 485 433 SELECT CASE ( nbondj ) 486 434 CASE ( -1 ) 487 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )488 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )435 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 436 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 489 437 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 490 438 CASE ( 0 ) 491 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )492 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )493 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )494 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )439 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 440 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 441 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 442 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 495 443 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 496 444 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 497 445 CASE ( 1 ) 498 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )499 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )446 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 447 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 500 448 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 501 449 END SELECT … … 507 455 CASE ( -1 ) 508 456 DO jl = 1, jprecj 509 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)457 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 510 458 END DO 511 459 CASE ( 0 ) 512 460 DO jl = 1, jprecj 513 ptab(:,jl ,:) = t3sn(:,jl,:,2)514 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)461 ptab(:,jl ,:) = zt3sn(:,jl,:,2) 462 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 515 463 END DO 516 464 CASE ( 1 ) 517 465 DO jl = 1, jprecj 518 ptab(:,jl,:) = t3sn(:,jl,:,2)466 ptab(:,jl,:) = zt3sn(:,jl,:,2) 519 467 END DO 520 468 END SELECT … … 533 481 ! 534 482 ENDIF 483 ! 484 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 535 485 ! 536 486 END SUBROUTINE mpp_lnk_obc_3d … … 567 517 REAL(wp) :: zland 568 518 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 569 !!---------------------------------------------------------------------- 519 ! 520 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 521 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 522 523 !!---------------------------------------------------------------------- 524 525 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 526 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 570 527 571 528 zland = 0.e0 ! zero by default … … 602 559 iihom = nlci-nreci 603 560 DO jl = 1, jpreci 604 t2ew(:,jl,1) = pt2d(jpreci+jl,:)605 t2we(:,jl,1) = pt2d(iihom +jl,:)561 zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 562 zt2we(:,jl,1) = pt2d(iihom +jl,:) 606 563 END DO 607 564 END SELECT … … 612 569 SELECT CASE ( nbondi ) 613 570 CASE ( -1 ) 614 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )615 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )571 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 572 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 616 573 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 617 574 CASE ( 0 ) 618 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )619 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )620 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )621 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )575 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 576 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 577 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 578 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 622 579 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 623 580 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 624 581 CASE ( 1 ) 625 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )626 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )582 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 583 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 627 584 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 628 585 END SELECT … … 634 591 CASE ( -1 ) 635 592 DO jl = 1, jpreci 636 pt2d(iihom+jl,:) = t2ew(:,jl,2)593 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 637 594 END DO 638 595 CASE ( 0 ) 639 596 DO jl = 1, jpreci 640 pt2d(jl ,:) = t2we(:,jl,2)641 pt2d(iihom+jl,:) = t2ew(:,jl,2)597 pt2d(jl ,:) = zt2we(:,jl,2) 598 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 642 599 END DO 643 600 CASE ( 1 ) 644 601 DO jl = 1, jpreci 645 pt2d(jl ,:) = t2we(:,jl,2)602 pt2d(jl ,:) = zt2we(:,jl,2) 646 603 END DO 647 604 END SELECT … … 655 612 ijhom = nlcj-nrecj 656 613 DO jl = 1, jprecj 657 t2sn(:,jl,1) = pt2d(:,ijhom +jl)658 t2ns(:,jl,1) = pt2d(:,jprecj+jl)614 zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 615 zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 659 616 END DO 660 617 ENDIF … … 665 622 SELECT CASE ( nbondj ) 666 623 CASE ( -1 ) 667 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )668 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )624 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 625 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 669 626 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 670 627 CASE ( 0 ) 671 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )672 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )673 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )674 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )628 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 629 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 630 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 631 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 675 632 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 676 633 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 677 634 CASE ( 1 ) 678 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )679 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )635 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 636 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 680 637 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 681 638 END SELECT … … 687 644 CASE ( -1 ) 688 645 DO jl = 1, jprecj 689 pt2d(:,ijhom+jl) = t2ns(:,jl,2)646 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 690 647 END DO 691 648 CASE ( 0 ) 692 649 DO jl = 1, jprecj 693 pt2d(:,jl ) = t2sn(:,jl,2)694 pt2d(:,ijhom+jl) = t2ns(:,jl,2)650 pt2d(:,jl ) = zt2sn(:,jl,2) 651 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 695 652 END DO 696 653 CASE ( 1 ) 697 654 DO jl = 1, jprecj 698 pt2d(:,jl ) = t2sn(:,jl,2)655 pt2d(:,jl ) = zt2sn(:,jl,2) 699 656 END DO 700 657 END SELECT … … 712 669 ! 713 670 ENDIF 671 ! 672 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 714 673 ! 715 674 END SUBROUTINE mpp_lnk_obc_2d … … 749 708 REAL(wp) :: zland 750 709 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 751 !!---------------------------------------------------------------------- 752 710 ! 711 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 712 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 713 714 !!---------------------------------------------------------------------- 715 716 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), & 717 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 718 719 ! 753 720 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 754 721 ELSE ; zland = 0.e0 ! zero by default … … 798 765 iihom = nlci-nreci 799 766 DO jl = 1, jpreci 800 t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)801 t3we(:,jl,:,1) = ptab(iihom +jl,:,:)767 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 768 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 802 769 END DO 803 770 END SELECT … … 808 775 SELECT CASE ( nbondi ) 809 776 CASE ( -1 ) 810 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )811 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )777 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 778 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 812 779 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 813 780 CASE ( 0 ) 814 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )815 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )816 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )817 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )781 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 782 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 783 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 784 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 818 785 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 819 786 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 820 787 CASE ( 1 ) 821 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )822 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )788 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 789 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 823 790 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 824 791 END SELECT … … 830 797 CASE ( -1 ) 831 798 DO jl = 1, jpreci 832 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)799 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 833 800 END DO 834 801 CASE ( 0 ) 835 802 DO jl = 1, jpreci 836 ptab(jl ,:,:) = t3we(:,jl,:,2)837 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)803 ptab(jl ,:,:) = zt3we(:,jl,:,2) 804 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 838 805 END DO 839 806 CASE ( 1 ) 840 807 DO jl = 1, jpreci 841 ptab(jl ,:,:) = t3we(:,jl,:,2)808 ptab(jl ,:,:) = zt3we(:,jl,:,2) 842 809 END DO 843 810 END SELECT … … 851 818 ijhom = nlcj-nrecj 852 819 DO jl = 1, jprecj 853 t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)854 t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)820 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 821 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 855 822 END DO 856 823 ENDIF … … 861 828 SELECT CASE ( nbondj ) 862 829 CASE ( -1 ) 863 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )864 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )830 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 831 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 865 832 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 866 833 CASE ( 0 ) 867 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )868 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )869 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )870 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )834 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 835 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 836 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 837 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 871 838 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 872 839 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 873 840 CASE ( 1 ) 874 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )875 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )841 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 842 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 876 843 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 877 844 END SELECT … … 883 850 CASE ( -1 ) 884 851 DO jl = 1, jprecj 885 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)852 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 886 853 END DO 887 854 CASE ( 0 ) 888 855 DO jl = 1, jprecj 889 ptab(:,jl ,:) = t3sn(:,jl,:,2)890 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)856 ptab(:,jl ,:) = zt3sn(:,jl,:,2) 857 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 891 858 END DO 892 859 CASE ( 1 ) 893 860 DO jl = 1, jprecj 894 ptab(:,jl,:) = t3sn(:,jl,:,2)861 ptab(:,jl,:) = zt3sn(:,jl,:,2) 895 862 END DO 896 863 END SELECT … … 908 875 ! 909 876 ENDIF 877 ! 878 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 910 879 ! 911 880 END SUBROUTINE mpp_lnk_3d … … 944 913 REAL(wp) :: zland 945 914 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 946 !!---------------------------------------------------------------------- 947 915 ! 916 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 917 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 918 919 !!---------------------------------------------------------------------- 920 921 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 922 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 923 924 ! 948 925 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 949 926 ELSE ; zland = 0.e0 ! zero by default … … 992 969 iihom = nlci-nreci 993 970 DO jl = 1, jpreci 994 t2ew(:,jl,1) = pt2d(jpreci+jl,:)995 t2we(:,jl,1) = pt2d(iihom +jl,:)971 zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 972 zt2we(:,jl,1) = pt2d(iihom +jl,:) 996 973 END DO 997 974 END SELECT … … 1002 979 SELECT CASE ( nbondi ) 1003 980 CASE ( -1 ) 1004 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )1005 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )981 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 982 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 1006 983 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1007 984 CASE ( 0 ) 1008 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )1009 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )1010 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )1011 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )985 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 986 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 987 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 988 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 1012 989 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1013 990 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1014 991 CASE ( 1 ) 1015 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )1016 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )992 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 993 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 1017 994 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1018 995 END SELECT … … 1024 1001 CASE ( -1 ) 1025 1002 DO jl = 1, jpreci 1026 pt2d(iihom+jl,:) = t2ew(:,jl,2)1003 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 1027 1004 END DO 1028 1005 CASE ( 0 ) 1029 1006 DO jl = 1, jpreci 1030 pt2d(jl ,:) = t2we(:,jl,2)1031 pt2d(iihom+jl,:) = t2ew(:,jl,2)1007 pt2d(jl ,:) = zt2we(:,jl,2) 1008 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 1032 1009 END DO 1033 1010 CASE ( 1 ) 1034 1011 DO jl = 1, jpreci 1035 pt2d(jl ,:) = t2we(:,jl,2)1012 pt2d(jl ,:) = zt2we(:,jl,2) 1036 1013 END DO 1037 1014 END SELECT … … 1045 1022 ijhom = nlcj-nrecj 1046 1023 DO jl = 1, jprecj 1047 t2sn(:,jl,1) = pt2d(:,ijhom +jl)1048 t2ns(:,jl,1) = pt2d(:,jprecj+jl)1024 zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 1025 zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 1049 1026 END DO 1050 1027 ENDIF … … 1055 1032 SELECT CASE ( nbondj ) 1056 1033 CASE ( -1 ) 1057 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )1058 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )1034 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 1035 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 1059 1036 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1060 1037 CASE ( 0 ) 1061 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )1062 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )1063 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )1064 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )1038 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 1039 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 1040 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 1041 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 1065 1042 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1066 1043 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1067 1044 CASE ( 1 ) 1068 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )1069 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )1045 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 1046 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 1070 1047 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1071 1048 END SELECT … … 1077 1054 CASE ( -1 ) 1078 1055 DO jl = 1, jprecj 1079 pt2d(:,ijhom+jl) = t2ns(:,jl,2)1056 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 1080 1057 END DO 1081 1058 CASE ( 0 ) 1082 1059 DO jl = 1, jprecj 1083 pt2d(:,jl ) = t2sn(:,jl,2)1084 pt2d(:,ijhom+jl) = t2ns(:,jl,2)1060 pt2d(:,jl ) = zt2sn(:,jl,2) 1061 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 1085 1062 END DO 1086 1063 CASE ( 1 ) 1087 1064 DO jl = 1, jprecj 1088 pt2d(:,jl ) = t2sn(:,jl,2)1065 pt2d(:,jl ) = zt2sn(:,jl,2) 1089 1066 END DO 1090 1067 END SELECT … … 1102 1079 ! 1103 1080 ENDIF 1081 ! 1082 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 1104 1083 ! 1105 1084 END SUBROUTINE mpp_lnk_2d … … 1137 1116 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 1138 1117 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 1139 !!---------------------------------------------------------------------- 1118 ! 1119 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zt4ns, zt4sn ! 2 x 3d for north-south & south-north 1120 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zt4ew, zt4we ! 2 x 3d for east-west & west-east 1121 1122 !!---------------------------------------------------------------------- 1123 ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) , & 1124 & zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) ) 1125 1140 1126 1141 1127 ! 1. standard boundary treatment … … 1171 1157 iihom = nlci-nreci 1172 1158 DO jl = 1, jpreci 1173 t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)1174 t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)1175 t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)1176 t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)1159 zt4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:) 1160 zt4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:) 1161 zt4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:) 1162 zt4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:) 1177 1163 END DO 1178 1164 END SELECT … … 1183 1169 SELECT CASE ( nbondi ) 1184 1170 CASE ( -1 ) 1185 CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 )1186 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea )1171 CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req1 ) 1172 CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea ) 1187 1173 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1188 1174 CASE ( 0 ) 1189 CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )1190 CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 )1191 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea )1192 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe )1175 CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 1176 CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req2 ) 1177 CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea ) 1178 CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe ) 1193 1179 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1194 1180 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 1195 1181 CASE ( 1 ) 1196 CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )1197 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe )1182 CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 1183 CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe ) 1198 1184 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1199 1185 END SELECT … … 1205 1191 CASE ( -1 ) 1206 1192 DO jl = 1, jpreci 1207 ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)1208 ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)1193 ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2) 1194 ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2) 1209 1195 END DO 1210 1196 CASE ( 0 ) 1211 1197 DO jl = 1, jpreci 1212 ptab1(jl ,:,:) = t4we(:,jl,:,1,2)1213 ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)1214 ptab2(jl ,:,:) = t4we(:,jl,:,2,2)1215 ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)1198 ptab1(jl ,:,:) = zt4we(:,jl,:,1,2) 1199 ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2) 1200 ptab2(jl ,:,:) = zt4we(:,jl,:,2,2) 1201 ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2) 1216 1202 END DO 1217 1203 CASE ( 1 ) 1218 1204 DO jl = 1, jpreci 1219 ptab1(jl ,:,:) = t4we(:,jl,:,1,2)1220 ptab2(jl ,:,:) = t4we(:,jl,:,2,2)1205 ptab1(jl ,:,:) = zt4we(:,jl,:,1,2) 1206 ptab2(jl ,:,:) = zt4we(:,jl,:,2,2) 1221 1207 END DO 1222 1208 END SELECT … … 1230 1216 ijhom = nlcj - nrecj 1231 1217 DO jl = 1, jprecj 1232 t4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)1233 t4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)1234 t4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)1235 t4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)1218 zt4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:) 1219 zt4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:) 1220 zt4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:) 1221 zt4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:) 1236 1222 END DO 1237 1223 ENDIF … … 1242 1228 SELECT CASE ( nbondj ) 1243 1229 CASE ( -1 ) 1244 CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 )1245 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono )1230 CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req1 ) 1231 CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono ) 1246 1232 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1247 1233 CASE ( 0 ) 1248 CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )1249 CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 )1250 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono )1251 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso )1234 CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 1235 CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req2 ) 1236 CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono ) 1237 CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso ) 1252 1238 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1253 1239 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 1254 1240 CASE ( 1 ) 1255 CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )1256 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso )1241 CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 1242 CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso ) 1257 1243 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1258 1244 END SELECT … … 1264 1250 CASE ( -1 ) 1265 1251 DO jl = 1, jprecj 1266 ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)1267 ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)1252 ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2) 1253 ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2) 1268 1254 END DO 1269 1255 CASE ( 0 ) 1270 1256 DO jl = 1, jprecj 1271 ptab1(:,jl ,:) = t4sn(:,jl,:,1,2)1272 ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)1273 ptab2(:,jl ,:) = t4sn(:,jl,:,2,2)1274 ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)1257 ptab1(:,jl ,:) = zt4sn(:,jl,:,1,2) 1258 ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2) 1259 ptab2(:,jl ,:) = zt4sn(:,jl,:,2,2) 1260 ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2) 1275 1261 END DO 1276 1262 CASE ( 1 ) 1277 1263 DO jl = 1, jprecj 1278 ptab1(:,jl,:) = t4sn(:,jl,:,1,2)1279 ptab2(:,jl,:) = t4sn(:,jl,:,2,2)1264 ptab1(:,jl,:) = zt4sn(:,jl,:,1,2) 1265 ptab2(:,jl,:) = zt4sn(:,jl,:,2,2) 1280 1266 END DO 1281 1267 END SELECT … … 1296 1282 ! 1297 1283 ENDIF 1284 ! 1285 DEALLOCATE( zt4ns, zt4sn, zt4ew, zt4we ) 1298 1286 ! 1299 1287 END SUBROUTINE mpp_lnk_3d_gather … … 2148 2136 INTEGER :: ml_stat(MPI_STATUS_SIZE) ! for key_mpi_isend 2149 2137 REAL(wp), POINTER, DIMENSION(:,:) :: ztab ! temporary workspace 2138 ! 2139 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 2140 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 2150 2141 LOGICAL :: lmigr ! is true for those processors that have to migrate the OB 2151 !!---------------------------------------------------------------------- 2142 2143 !!---------------------------------------------------------------------- 2144 2145 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 2146 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 2152 2147 2153 2148 CALL wrk_alloc( jpi,jpj, ztab ) … … 2213 2208 IF( nbondi /= 2 ) THEN ! Read Dirichlet lateral conditions 2214 2209 iihom = nlci-nreci 2215 t2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0)2216 t2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0)2210 zt2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0) 2211 zt2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0) 2217 2212 ENDIF 2218 2213 ! … … 2221 2216 ! 2222 2217 IF( nbondi == -1 ) THEN 2223 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )2224 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )2218 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 2219 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 2225 2220 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2226 2221 ELSEIF( nbondi == 0 ) THEN 2227 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )2228 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )2229 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )2230 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )2222 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 2223 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 2224 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 2225 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 2231 2226 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2232 2227 IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 2233 2228 ELSEIF( nbondi == 1 ) THEN 2234 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )2235 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )2229 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 2230 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 2236 2231 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2237 2232 ENDIF … … 2241 2236 ! 2242 2237 IF( nbondi == 0 .OR. nbondi == 1 ) THEN 2243 ztab(1:jpreci, ijpt0) = t2we(1:jpreci,1,2)2238 ztab(1:jpreci, ijpt0) = zt2we(1:jpreci,1,2) 2244 2239 ENDIF 2245 2240 IF( nbondi == -1 .OR. nbondi == 0 ) THEN 2246 ztab(iihom+1:iihom+jpreci, ijpt0) = t2ew(1:jpreci,1,2)2241 ztab(iihom+1:iihom+jpreci, ijpt0) = zt2ew(1:jpreci,1,2) 2247 2242 ENDIF 2248 2243 ENDIF ! (ktype == 1) … … 2254 2249 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 2255 2250 ijhom = nlcj-nrecj 2256 t2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj)2257 t2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj)2251 zt2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj) 2252 zt2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj) 2258 2253 ENDIF 2259 2254 ! … … 2262 2257 ! 2263 2258 IF( nbondj == -1 ) THEN 2264 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )2265 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )2259 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 2260 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 2266 2261 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2267 2262 ELSEIF( nbondj == 0 ) THEN 2268 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )2269 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )2270 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )2271 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )2263 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 2264 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 2265 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 2266 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 2272 2267 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2273 2268 IF( l_isend ) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 2274 2269 ELSEIF( nbondj == 1 ) THEN 2275 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )2276 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso)2270 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 2271 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso) 2277 2272 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2278 2273 ENDIF … … 2281 2276 ijhom = nlcj - jprecj 2282 2277 IF( nbondj == 0 .OR. nbondj == 1 ) THEN 2283 ztab(iipt0,1:jprecj) = t2sn(1:jprecj,1,2)2278 ztab(iipt0,1:jprecj) = zt2sn(1:jprecj,1,2) 2284 2279 ENDIF 2285 2280 IF( nbondj == 0 .OR. nbondj == -1 ) THEN 2286 ztab(iipt0, ijhom+1:ijhom+jprecj) = t2ns(1:jprecj,1,2)2281 ztab(iipt0, ijhom+1:ijhom+jprecj) = zt2ns(1:jprecj,1,2) 2287 2282 ENDIF 2288 2283 ENDIF ! (ktype == 2) … … 2304 2299 ! 2305 2300 ENDIF ! ( lmigr ) 2301 ! 2302 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 2306 2303 CALL wrk_dealloc( jpi,jpj, ztab ) 2307 2304 ! … … 2593 2590 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 2594 2591 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for mpi_isend when avoiding mpi_allgather 2595 !!---------------------------------------------------------------------- 2596 ! 2592 ! ! Workspace for message transfers avoiding mpi_allgather 2593 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztab 2594 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: znorthloc, zfoldwk 2595 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: znorthgloio 2596 2597 !!---------------------------------------------------------------------- 2598 ! 2599 ALLOCATE( ztab(jpiglo,4,jpk), znorthloc(jpi,4,jpk), zfoldwk(jpi,4,jpk), znorthgloio(jpi,4,jpk,jpni) ) 2600 2597 2601 ijpj = 4 2598 2602 ityp = -1 2599 2603 ijpjm1 = 3 2600 tab_3d(:,:,:) = 0.e02601 ! 2602 DO jj = nlcj - ijpj +1, nlcj ! put in xnorthloc the last 4 jlines of pt3d2604 ztab(:,:,:) = 0.e0 2605 ! 2606 DO jj = nlcj - ijpj +1, nlcj ! put in znorthloc the last 4 jlines of pt3d 2603 2607 ij = jj - nlcj + ijpj 2604 xnorthloc(:,ij,:) = pt3d(:,jj,:)2608 znorthloc(:,ij,:) = pt3d(:,jj,:) 2605 2609 END DO 2606 2610 ! 2607 ! ! Build in procs of ncomm_north the xnorthgloio2611 ! ! Build in procs of ncomm_north the znorthgloio 2608 2612 itaille = jpi * jpk * ijpj 2609 2613 IF ( l_north_nogather ) THEN … … 2615 2619 ij = jj - nlcj + ijpj 2616 2620 DO ji = 1, nlci 2617 tab_3d(ji+nimpp-1,ij,:) = pt3d(ji,jj,:)2621 ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 2618 2622 END DO 2619 2623 END DO … … 2640 2644 2641 2645 DO jr = 1,nsndto(ityp) 2642 CALL mppsend(5, xnorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )2646 CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2643 2647 END DO 2644 2648 DO jr = 1,nsndto(ityp) 2645 CALL mpprecv(5, foldwk, itaille, isendto(jr,ityp))2649 CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp)) 2646 2650 iproc = isendto(jr,ityp) + 1 2647 2651 ildi = nldit (iproc) … … 2650 2654 DO jj = 1, ijpj 2651 2655 DO ji = ildi, ilei 2652 tab_3d(ji+iilb-1,jj,:) =foldwk(ji,jj,:)2656 ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:) 2653 2657 END DO 2654 2658 END DO … … 2665 2669 2666 2670 IF ( ityp .lt. 0 ) THEN 2667 CALL MPI_ALLGATHER( xnorthloc , itaille, MPI_DOUBLE_PRECISION, &2668 & xnorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2671 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, & 2672 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2669 2673 ! 2670 2674 DO jr = 1, ndim_rank_north ! recover the global north array … … 2675 2679 DO jj = 1, ijpj 2676 2680 DO ji = ildi, ilei 2677 tab_3d(ji+iilb-1,jj,:) = xnorthgloio(ji,jj,:,jr)2681 ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr) 2678 2682 END DO 2679 2683 END DO … … 2681 2685 ENDIF 2682 2686 ! 2683 ! The tab_3darray has been either:2687 ! The ztab array has been either: 2684 2688 ! a. Fully populated by the mpi_allgather operation or 2685 2689 ! b. Had the active points for this domain and northern neighbours populated … … 2688 2692 ! this domain will be identical. 2689 2693 ! 2690 CALL lbc_nfd( tab_3d, cd_type, psgn ) ! North fold boundary condition2694 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition 2691 2695 ! 2692 2696 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d 2693 2697 ij = jj - nlcj + ijpj 2694 2698 DO ji= 1, nlci 2695 pt3d(ji,jj,:) = tab_3d(ji+nimpp-1,ij,:)2699 pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:) 2696 2700 END DO 2697 2701 END DO 2702 ! 2703 DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 2698 2704 ! 2699 2705 END SUBROUTINE mpp_lbc_north_3d … … 2725 2731 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 2726 2732 INTEGER, DIMENSION(MPI_STATUS_SIZE):: ml_stat ! for mpi_isend when avoiding mpi_allgather 2727 !!---------------------------------------------------------------------- 2733 ! ! Workspace for message transfers avoiding mpi_allgather 2734 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab 2735 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: znorthloc, zfoldwk 2736 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio 2737 !!---------------------------------------------------------------------- 2738 ! 2739 ALLOCATE( ztab(jpiglo,4), znorthloc(jpi,4), zfoldwk(jpi,4), znorthgloio(jpi,4,jpni) ) 2728 2740 ! 2729 2741 ijpj = 4 2730 2742 ityp = -1 2731 2743 ijpjm1 = 3 2732 tab_2d(:,:) = 0.e02733 ! 2734 DO jj = nlcj-ijpj+1, nlcj ! put in xnorthloc_2dthe last 4 jlines of pt2d2744 ztab(:,:) = 0.e0 2745 ! 2746 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc the last 4 jlines of pt2d 2735 2747 ij = jj - nlcj + ijpj 2736 xnorthloc_2d(:,ij) = pt2d(:,jj)2748 znorthloc(:,ij) = pt2d(:,jj) 2737 2749 END DO 2738 2750 2739 ! ! Build in procs of ncomm_north the xnorthgloio_2d2751 ! ! Build in procs of ncomm_north the znorthgloio 2740 2752 itaille = jpi * ijpj 2741 2753 IF ( l_north_nogather ) THEN … … 2747 2759 ij = jj - nlcj + ijpj 2748 2760 DO ji = 1, nlci 2749 tab_2d(ji+nimpp-1,ij) = pt2d(ji,jj)2761 ztab(ji+nimpp-1,ij) = pt2d(ji,jj) 2750 2762 END DO 2751 2763 END DO … … 2773 2785 2774 2786 DO jr = 1,nsndto(ityp) 2775 CALL mppsend(5, xnorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) )2787 CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2776 2788 END DO 2777 2789 DO jr = 1,nsndto(ityp) 2778 CALL mpprecv(5, foldwk_2d, itaille, isendto(jr,ityp))2790 CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp)) 2779 2791 iproc = isendto(jr,ityp) + 1 2780 2792 ildi = nldit (iproc) … … 2783 2795 DO jj = 1, ijpj 2784 2796 DO ji = ildi, ilei 2785 tab_2d(ji+iilb-1,jj) = foldwk_2d(ji,jj)2797 ztab(ji+iilb-1,jj) = zfoldwk(ji,jj) 2786 2798 END DO 2787 2799 END DO … … 2798 2810 2799 2811 IF ( ityp .lt. 0 ) THEN 2800 CALL MPI_ALLGATHER( xnorthloc_2d, itaille, MPI_DOUBLE_PRECISION, &2801 & xnorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2812 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, & 2813 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2802 2814 ! 2803 2815 DO jr = 1, ndim_rank_north ! recover the global north array … … 2808 2820 DO jj = 1, ijpj 2809 2821 DO ji = ildi, ilei 2810 tab_2d(ji+iilb-1,jj) = xnorthgloio_2d(ji,jj,jr)2822 ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr) 2811 2823 END DO 2812 2824 END DO … … 2814 2826 ENDIF 2815 2827 ! 2816 ! The tab array has been either:2828 ! The ztab array has been either: 2817 2829 ! a. Fully populated by the mpi_allgather operation or 2818 2830 ! b. Had the active points for this domain and northern neighbours populated … … 2821 2833 ! this domain will be identical. 2822 2834 ! 2823 CALL lbc_nfd( tab_2d, cd_type, psgn ) ! North fold boundary condition2835 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition 2824 2836 ! 2825 2837 ! … … 2827 2839 ij = jj - nlcj + ijpj 2828 2840 DO ji = 1, nlci 2829 pt2d(ji,jj) = tab_2d(ji+nimpp-1,ij)2841 pt2d(ji,jj) = ztab(ji+nimpp-1,ij) 2830 2842 END DO 2831 2843 END DO 2844 ! 2845 DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 2832 2846 ! 2833 2847 END SUBROUTINE mpp_lbc_north_2d … … 2857 2871 INTEGER :: ierr, itaille, ildi, ilei, iilb 2858 2872 INTEGER :: ijpj, ij, iproc 2859 !!---------------------------------------------------------------------- 2873 ! 2874 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab_e, znorthloc_e 2875 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio_e 2876 2877 !!---------------------------------------------------------------------- 2878 ! 2879 ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) ) 2880 2860 2881 ! 2861 2882 ijpj=4 2862 tab_e(:,:) = 0.e02883 ztab_e(:,:) = 0.e0 2863 2884 2864 2885 ij=0 2865 ! put in xnorthloc_e the last 4 jlines of pt2d2886 ! put in znorthloc_e the last 4 jlines of pt2d 2866 2887 DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj 2867 2888 ij = ij + 1 2868 2889 DO ji = 1, jpi 2869 xnorthloc_e(ji,ij)=pt2d(ji,jj)2890 znorthloc_e(ji,ij)=pt2d(ji,jj) 2870 2891 END DO 2871 2892 END DO 2872 2893 ! 2873 2894 itaille = jpi * ( ijpj + 2 * jpr2dj ) 2874 CALL MPI_ALLGATHER( xnorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, &2875 & xnorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2895 CALL MPI_ALLGATHER( znorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, & 2896 & znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2876 2897 ! 2877 2898 DO jr = 1, ndim_rank_north ! recover the global north array … … 2882 2903 DO jj = 1, ijpj+2*jpr2dj 2883 2904 DO ji = ildi, ilei 2884 tab_e(ji+iilb-1,jj) = xnorthgloio_e(ji,jj,jr)2905 ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 2885 2906 END DO 2886 2907 END DO … … 2890 2911 ! 2. North-Fold boundary conditions 2891 2912 ! ---------------------------------- 2892 CALL lbc_nfd( tab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )2913 CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj ) 2893 2914 2894 2915 ij = jpr2dj … … 2897 2918 ij = ij +1 2898 2919 DO ji= 1, nlci 2899 pt2d(ji,jj) = tab_e(ji+nimpp-1,ij)2920 pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 2900 2921 END DO 2901 2922 END DO 2923 ! 2924 DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e ) 2902 2925 ! 2903 2926 END SUBROUTINE mpp_lbc_north_e … … 2940 2963 REAL(wp) :: zland 2941 2964 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 2942 !!---------------------------------------------------------------------- 2965 ! 2966 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 2967 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 2968 2969 !!---------------------------------------------------------------------- 2970 2971 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), & 2972 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 2943 2973 2944 2974 zland = 0.e0 … … 2980 3010 iihom = nlci-nreci 2981 3011 DO jl = 1, jpreci 2982 t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)2983 t3we(:,jl,:,1) = ptab(iihom +jl,:,:)3012 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 3013 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 2984 3014 END DO 2985 3015 END SELECT … … 2990 3020 SELECT CASE ( nbondi_bdy(ib_bdy) ) 2991 3021 CASE ( -1 ) 2992 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )2993 CASE ( 0 ) 2994 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )2995 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )3022 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 3023 CASE ( 0 ) 3024 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 3025 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 2996 3026 CASE ( 1 ) 2997 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )3027 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 2998 3028 END SELECT 2999 3029 ! 3000 3030 SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 3001 3031 CASE ( -1 ) 3002 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )3003 CASE ( 0 ) 3004 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )3005 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )3032 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 3033 CASE ( 0 ) 3034 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 3035 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 3006 3036 CASE ( 1 ) 3007 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )3037 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 3008 3038 END SELECT 3009 3039 ! … … 3024 3054 CASE ( -1 ) 3025 3055 DO jl = 1, jpreci 3026 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)3056 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 3027 3057 END DO 3028 3058 CASE ( 0 ) 3029 3059 DO jl = 1, jpreci 3030 ptab(jl ,:,:) = t3we(:,jl,:,2)3031 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)3060 ptab(jl ,:,:) = zt3we(:,jl,:,2) 3061 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 3032 3062 END DO 3033 3063 CASE ( 1 ) 3034 3064 DO jl = 1, jpreci 3035 ptab(jl ,:,:) = t3we(:,jl,:,2)3065 ptab(jl ,:,:) = zt3we(:,jl,:,2) 3036 3066 END DO 3037 3067 END SELECT … … 3045 3075 ijhom = nlcj-nrecj 3046 3076 DO jl = 1, jprecj 3047 t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)3048 t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)3077 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 3078 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 3049 3079 END DO 3050 3080 ENDIF … … 3055 3085 SELECT CASE ( nbondj_bdy(ib_bdy) ) 3056 3086 CASE ( -1 ) 3057 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )3058 CASE ( 0 ) 3059 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )3060 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )3087 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 3088 CASE ( 0 ) 3089 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 3090 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 3061 3091 CASE ( 1 ) 3062 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )3092 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 3063 3093 END SELECT 3064 3094 ! 3065 3095 SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 3066 3096 CASE ( -1 ) 3067 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )3068 CASE ( 0 ) 3069 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )3070 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )3097 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 3098 CASE ( 0 ) 3099 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 3100 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 3071 3101 CASE ( 1 ) 3072 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )3102 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 3073 3103 END SELECT 3074 3104 ! … … 3089 3119 CASE ( -1 ) 3090 3120 DO jl = 1, jprecj 3091 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)3121 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 3092 3122 END DO 3093 3123 CASE ( 0 ) 3094 3124 DO jl = 1, jprecj 3095 ptab(:,jl ,:) = t3sn(:,jl,:,2)3096 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)3125 ptab(:,jl ,:) = zt3sn(:,jl,:,2) 3126 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 3097 3127 END DO 3098 3128 CASE ( 1 ) 3099 3129 DO jl = 1, jprecj 3100 ptab(:,jl,:) = t3sn(:,jl,:,2)3130 ptab(:,jl,:) = zt3sn(:,jl,:,2) 3101 3131 END DO 3102 3132 END SELECT … … 3114 3144 ! 3115 3145 ENDIF 3146 ! 3147 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 3116 3148 ! 3117 3149 END SUBROUTINE mpp_lnk_bdy_3d … … 3154 3186 REAL(wp) :: zland 3155 3187 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 3156 !!---------------------------------------------------------------------- 3188 ! 3189 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 3190 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 3191 3192 !!---------------------------------------------------------------------- 3193 3194 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 3195 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 3157 3196 3158 3197 zland = 0.e0 … … 3194 3233 iihom = nlci-nreci 3195 3234 DO jl = 1, jpreci 3196 t2ew(:,jl,1) = ptab(jpreci+jl,:)3197 t2we(:,jl,1) = ptab(iihom +jl,:)3235 zt2ew(:,jl,1) = ptab(jpreci+jl,:) 3236 zt2we(:,jl,1) = ptab(iihom +jl,:) 3198 3237 END DO 3199 3238 END SELECT … … 3204 3243 SELECT CASE ( nbondi_bdy(ib_bdy) ) 3205 3244 CASE ( -1 ) 3206 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )3207 CASE ( 0 ) 3208 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )3209 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )3245 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 3246 CASE ( 0 ) 3247 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 3248 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 3210 3249 CASE ( 1 ) 3211 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )3250 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 3212 3251 END SELECT 3213 3252 ! 3214 3253 SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 3215 3254 CASE ( -1 ) 3216 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )3217 CASE ( 0 ) 3218 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )3219 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )3255 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 3256 CASE ( 0 ) 3257 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 3258 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 3220 3259 CASE ( 1 ) 3221 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )3260 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 3222 3261 END SELECT 3223 3262 ! … … 3238 3277 CASE ( -1 ) 3239 3278 DO jl = 1, jpreci 3240 ptab(iihom+jl,:) = t2ew(:,jl,2)3279 ptab(iihom+jl,:) = zt2ew(:,jl,2) 3241 3280 END DO 3242 3281 CASE ( 0 ) 3243 3282 DO jl = 1, jpreci 3244 ptab(jl ,:) = t2we(:,jl,2)3245 ptab(iihom+jl,:) = t2ew(:,jl,2)3283 ptab(jl ,:) = zt2we(:,jl,2) 3284 ptab(iihom+jl,:) = zt2ew(:,jl,2) 3246 3285 END DO 3247 3286 CASE ( 1 ) 3248 3287 DO jl = 1, jpreci 3249 ptab(jl ,:) = t2we(:,jl,2)3288 ptab(jl ,:) = zt2we(:,jl,2) 3250 3289 END DO 3251 3290 END SELECT … … 3259 3298 ijhom = nlcj-nrecj 3260 3299 DO jl = 1, jprecj 3261 t2sn(:,jl,1) = ptab(:,ijhom +jl)3262 t2ns(:,jl,1) = ptab(:,jprecj+jl)3300 zt2sn(:,jl,1) = ptab(:,ijhom +jl) 3301 zt2ns(:,jl,1) = ptab(:,jprecj+jl) 3263 3302 END DO 3264 3303 ENDIF … … 3269 3308 SELECT CASE ( nbondj_bdy(ib_bdy) ) 3270 3309 CASE ( -1 ) 3271 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )3272 CASE ( 0 ) 3273 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )3274 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )3310 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 3311 CASE ( 0 ) 3312 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 3313 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 3275 3314 CASE ( 1 ) 3276 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )3315 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 3277 3316 END SELECT 3278 3317 ! 3279 3318 SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 3280 3319 CASE ( -1 ) 3281 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )3282 CASE ( 0 ) 3283 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )3284 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )3320 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 3321 CASE ( 0 ) 3322 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 3323 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 3285 3324 CASE ( 1 ) 3286 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )3325 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 3287 3326 END SELECT 3288 3327 ! … … 3303 3342 CASE ( -1 ) 3304 3343 DO jl = 1, jprecj 3305 ptab(:,ijhom+jl) = t2ns(:,jl,2)3344 ptab(:,ijhom+jl) = zt2ns(:,jl,2) 3306 3345 END DO 3307 3346 CASE ( 0 ) 3308 3347 DO jl = 1, jprecj 3309 ptab(:,jl ) = t2sn(:,jl,2)3310 ptab(:,ijhom+jl) = t2ns(:,jl,2)3348 ptab(:,jl ) = zt2sn(:,jl,2) 3349 ptab(:,ijhom+jl) = zt2ns(:,jl,2) 3311 3350 END DO 3312 3351 CASE ( 1 ) 3313 3352 DO jl = 1, jprecj 3314 ptab(:,jl) = t2sn(:,jl,2)3353 ptab(:,jl) = zt2sn(:,jl,2) 3315 3354 END DO 3316 3355 END SELECT … … 3328 3367 ! 3329 3368 ENDIF 3369 ! 3370 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 3330 3371 ! 3331 3372 END SUBROUTINE mpp_lnk_bdy_2d -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3769 r4015 29 29 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 30 30 !! 3.4 ! 2011-11 (C. Harris) decomposition changes for running with CICE 31 !! ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 31 32 !!---------------------------------------------------------------------- 32 33 … … 84 85 #endif 85 86 USE sbctide, ONLY: lk_tide 87 USE crsini ! initialise grid coarsening utility 86 88 87 89 IMPLICIT NONE … … 347 349 CALL dyn_nept_init ! simplified form of Neptune effect 348 350 349 ! ! Ocean physics 351 ! 352 IF( ln_crs ) CALL crs_init ! Domain initialization of coarsened grid 353 ! 354 ! Ocean physics 350 355 CALL sbc_init ! Forcings : surface module 351 356 ! ! Vertical physics … … 553 558 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 554 559 ! 555 ierr = ierr + lib_mpp_alloc (numout) ! mpp exchanges556 560 ierr = ierr + trc_oce_alloc () ! shared TRC / TRA arrays 557 561 ! -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/oce.F90
r3625 r4015 47 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gru , grv !: horizontal gradient of rd at bottom u-point 48 48 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rke !: kinetic energy 50 49 51 !! arrays relating to embedding ice in the ocean. These arrays need to be declared 50 52 !! even if no ice model is required. In the no ice model or traditional levitating … … 79 81 ALLOCATE( rhd (jpi,jpj,jpk) , & 80 82 & rhop(jpi,jpj,jpk) , & 83 & rke (jpi,jpj,jpk) , & 81 84 & sshb (jpi,jpj) , sshn (jpi,jpj) , ssha (jpi,jpj) , & 82 85 & sshu_b(jpi,jpj) , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) , & -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_AMM_12km.h90
r3680 r4015 4 4 !! (AMM_12km configuration VN3.3) 5 5 !!--------------------------------------------------------------------- 6 CHARACTER (len=16) & 7 #if !defined key_agrif 8 , PARAMETER & 9 #endif 10 :: & 11 cp_cfg = "amm" !: name of the configuration 12 INTEGER & 13 #if !defined key_agrif 14 , PARAMETER & 15 #endif 16 :: & 17 jp_cfg = 011 , & !: resolution of the configuration (degrees) 6 CHARACTER (len=16) :: cp_cfg = "amm" !: name of the configuration 7 INTEGER :: jp_cfg = 011 !: resolution of the configuration (degrees) 8 INTEGER, PARAMETER :: & 18 9 ! Original data size 19 10 jpidta = 198, & !: first horizontal dimension > or = to jpi 20 11 jpjdta = 224, & !: second > or = to jpj 21 jpkdta = 51, & !: number of levels > or = to jpk 12 jpkdta = 33 !: number of levels > or = to jpk 13 INTEGER :: & 22 14 ! total domain matrix size 23 15 jpiglo = jpidta, & !: first dimension of global domain --> i -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R2.h90
r2715 r4015 8 8 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 9 9 !!---------------------------------------------------------------------- 10 CHARACTER (len=16) & 11 #if !defined key_agrif 12 , PARAMETER & 13 #endif 14 :: & 15 cp_cfg = "eel" !: name of the configuration 16 INTEGER & 17 #if !defined key_agrif 18 , PARAMETER & 19 #endif 20 :: & 21 jp_cfg = 2 , & !: resolution of the configuration (km) 22 10 CHARACTER (len=16) :: cp_cfg = "eel" !: name of the configuration 11 INTEGER :: jp_cfg = 2 !: resolution of the configuration (km) 12 INTEGER, PARAMETER :: & 23 13 ! data size !!! * size of all the input files * 24 14 jpidta = 83, & !: 1st horizontal dimension ( >= jpi ) … … 26 16 jpkdta = 30, & !: number of levels ( >= jpk ) 27 17 18 INTEGER :: & 28 19 ! global domain size !!! * full domain * 29 20 jpiglo = jpidta, & !: 1st dimension of global domain --> i -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R5.h90
r2715 r4015 8 8 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 9 9 !!---------------------------------------------------------------------- 10 CHARACTER (len=16) & 11 #if !defined key_agrif 12 , PARAMETER & 13 #endif 14 :: & 15 cp_cfg = "eel" !: name of the configuration 16 INTEGER & 17 #if !defined key_agrif 18 , PARAMETER & 19 #endif 20 :: & 21 jp_cfg = 5 , & !: resolution of the configuration (km) 22 10 CHARACTER (len=16) :: cp_cfg = "eel" !: name of the configuration 11 INTEGER :: jp_cfg = 5 !: resolution of the configuration (km) 12 INTEGER, PARAMETER :: & 23 13 ! data size !!! * size of all the input files 24 14 jpidta = 66 , & !: first horizontal dimension > or = to jpi 25 15 jpjdta = 66 , & !: second > or = to jpj 26 jpkdta = 31 , &!: number of levels > or = to jpk16 jpkdta = 31 !: number of levels > or = to jpk 27 17 18 INTEGER :: & 28 19 ! total domain size !!! * full domain * 29 20 jpiglo = jpidta, & !: first dimension of global domain --> i -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R6.h90
r2715 r4015 8 8 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 9 9 !!---------------------------------------------------------------------- 10 CHARACTER (len=16) & 11 #if !defined key_agrif 12 , PARAMETER & 13 #endif 14 :: & 15 cp_cfg = "eel" !: name of the configuration 16 INTEGER & 17 #if !defined key_agrif 18 , PARAMETER & 19 #endif 20 :: & 21 jp_cfg = 6 , & !: resolution of the configuration (km) 22 10 CHARACTER (len=16) :: cp_cfg = "eel" !: name of the configuration 11 INTEGER :: jp_cfg = 6 !: resolution of the configuration (km) 12 INTEGER, PARAMETER :: & 23 13 ! data size !!! * size of all the input files * 24 14 jpidta = 29, & !: 1st lateral dimension ( >= jpi ) … … 26 16 jpkdta = 30, & !: number of levels ( >= jpk ) 27 17 18 INTEGER :: & 28 19 ! global domain size !!! * full domain * 29 20 jpiglo = jpidta, & !: 1st dimension of global domain --> i -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_GYRE.h90
r2715 r4015 8 8 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 9 9 !!---------------------------------------------------------------------- 10 CHARACTER (len=16) & 11 #if !defined key_agrif 12 , PARAMETER & 13 #endif 14 :: & 15 cp_cfg = "gyre" !: name of the configuration 16 INTEGER & 17 #if !defined key_agrif 18 , PARAMETER & 19 #endif 20 :: & 21 jp_cfg = 1 , & !: 22 10 CHARACTER (len=16) :: cp_cfg = "gyre" !: name of the configuration 11 INTEGER :: jp_cfg = 1 !: resolution of the configuration 12 INTEGER, PARAMETER :: & 23 13 ! data size !!! * size of all the input files * 24 14 jpidta = 30*jp_cfg+2, & !: 1st horizontal dimension ( >= jpi ) 25 15 jpjdta = 20*jp_cfg+2, & !: 2nd " " ( >= jpj ) 26 jpkdta = 31 , &!: number of levels ( >= jpk )16 jpkdta = 31 !: number of levels ( >= jpk ) 27 17 18 INTEGER :: & 28 19 ! global domain size !!! * full domain * 29 20 jpiglo = jpidta, & !: 1st dimension of global domain --> i -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R025.h90
r2715 r4015 9 9 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 10 10 !!---------------------------------------------------------------------- 11 CHARACTER (len=16) & 12 #if !defined key_agrif 13 , PARAMETER & 14 #endif 15 :: & 16 cp_cfg = "orca" !: name of the configuration 17 INTEGER & 18 #if !defined key_agrif 19 , PARAMETER & 20 #endif 21 :: & 22 jp_cfg = 025 , & !: resolution of the configuration (degrees) 11 CHARACTER (len=16) :: cp_cfg = "orca" !: name of the configuration 12 INTEGER :: jp_cfg = 025 !: resolution of the configuration (degrees) 13 INTEGER, PARAMETER :: & 23 14 ! Original data size 24 15 jpidta = 1442, & !: first horizontal dimension > or = to jpi 25 16 jpjdta = 1021, & !: second > or = to jpj 26 17 #if key_orca_r025==75 27 jpkdta = 75 , &!: number of levels > or = to jpk18 jpkdta = 75 !: number of levels > or = to jpk 28 19 #else 29 jpkdta = 46 , &!: number of levels > or = to jpk20 jpkdta = 46 !: number of levels > or = to jpk 30 21 #endif 22 INTEGER :: & 31 23 ! total domain matrix size 32 24 jpiglo = jpidta, & !: first dimension of global domain --> i -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R05.h90
r2715 r4015 9 9 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 10 10 !!---------------------------------------------------------------------- 11 CHARACTER (len=16) & 12 #if !defined key_agrif 13 , PARAMETER & 14 #endif 15 :: & 16 cp_cfg = "orca" !: name of the configuration 17 INTEGER & 18 #if !defined key_agrif 19 , PARAMETER & 20 #endif 21 :: & 22 jp_cfg = 05 , & !: resolution of the configuration (degrees) 23 24 ! data size !!! * size of all the input files * 11 CHARACTER (len=16) :: cp_cfg = "orca" !: name of the configuration 12 INTEGER :: jp_cfg = 05 !: resolution of the configuration (degrees) 13 INTEGER, PARAMETER :: & 14 ! data size !!! * size of all input files * 25 15 jpidta = 722, & !: 1st lateral dimension > or = to jpiglo 26 16 jpjdta = 511, & !: 2nd " " > or = to jpjglo … … 29 19 #if defined key_antarctic 30 20 ! zoom domain size !!! * antarctic zoom * 31 INTEGER & 32 #if !defined key_agrif 33 , PARAMETER & 34 #endif 35 :: & 21 INTEGER :: & 36 22 jpiglo = jpidta, & !: 1st dimension of global domain --> i 37 23 jpjglo = 187 , & !: 2nd " " --> j … … 44 30 #elif defined key_arctic 45 31 ! zoom domain size !!! * arctic zoom * 46 INTEGER & 47 #if !defined key_agrif 48 , PARAMETER & 49 #endif 50 :: & 32 INTEGER :: 51 33 ! zoom domain size !!! * arctic zoom * 52 34 jpiglo = 562, & !: 1st dimension of global domain --> i … … 60 42 #else 61 43 ! global domain size !!! * global domain * 62 INTEGER & 63 #if !defined key_agrif 64 , PARAMETER & 65 #endif 66 :: & 44 INTEGER :: & 67 45 jpiglo = jpidta, & !: 1st dimension of global domain --> i 68 46 jpjglo = jpjdta, & !: 2nd " " --> j -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R1.h90
r2715 r4015 12 12 !! Use: key_orca_r1=75 to set 75 levels 13 13 !!---------------------------------------------------------------------- 14 CHARACTER (len=16) & 15 #if !defined key_agrif 16 , PARAMETER & 17 #endif 18 :: & 19 cp_cfg = "orca" !: name of the configuration 20 INTEGER & 21 #if !defined key_agrif 22 , PARAMETER & 23 #endif 24 :: & 25 jp_cfg = 1 , & !: resolution of the configuration (degrees) 14 CHARACTER (len=16) :: cp_cfg = "orca" !: name of the configuration 15 INTEGER :: jp_cfg = 1 !: resolution of the configuration (degrees) 16 INTEGER, PARAMETER :: & 26 17 ! Original data size 27 18 jpidta = 362, & !: first horizontal dimension > or = to jpi 28 19 jpjdta = 292, & !: second > or = to jpj 29 20 #if key_orca_r1==75 30 jpkdta = 75 , &!: number of levels > or = to jpk21 jpkdta = 75 !: number of levels > or = to jpk 31 22 #else 32 jpkdta = 46 , &!: number of levels > or = to jpk23 jpkdta = 46 !: number of levels > or = to jpk 33 24 #endif 25 26 INTEGER :: & 34 27 ! total domain matrix size 35 28 jpiglo = jpidta, & !: first dimension of global domain --> i -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R2.h90
r2715 r4015 9 9 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 10 10 !!---------------------------------------------------------------------- 11 CHARACTER (len=16) & 12 #if !defined key_agrif 13 , PARAMETER & 14 #endif 15 :: & 16 cp_cfg = "orca" !: name of the configuration 17 INTEGER & 18 #if !defined key_agrif 19 , PARAMETER & 20 #endif 21 :: & 22 jp_cfg = 2, & !: resolution of the configuration (degrees) 23 11 CHARACTER (len=16) :: cp_cfg = "orca" !: name of the configuration 12 INTEGER :: jp_cfg = 2 !: resolution of the configuration (degrees) 13 INTEGER, PARAMETER :: & 24 14 ! data size !!! * size of all input files * 25 15 jpidta = 182, & !: 1st lateral dimension ( >= jpiglo ) … … 29 19 #if defined key_antarctic 30 20 ! zoom domain size !!! * antarctic zoom * 31 INTEGER & 32 #if !defined key_agrif 33 , PARAMETER & 34 #endif 35 :: & 21 INTEGER :: & 36 22 jpiglo = jpidta, & !: 1st dimension of global domain --> i 37 23 jpjglo = 50, & !: 2nd " " --> j … … 44 30 #elif defined key_arctic 45 31 ! zoom domain size !!! * arctic zoom * 46 INTEGER & 47 #if !defined key_agrif 48 , PARAMETER & 49 #endif 50 :: & 32 INTEGER :: & 51 33 jpiglo = 142 , & !: 1st dimension of global domain --> i 52 34 jpjglo = jpjdta-97+1, & !: 2nd " " --> j … … 59 41 #elif defined key_c1d 60 42 ! global domain size !!! * global domain * 61 INTEGER & 62 #if !defined key_agrif 63 , PARAMETER & 64 #endif 65 :: & 43 INTEGER :: & 66 44 jpiglo = 3 , & !: 1st dimension of global domain --> i 67 45 jpjglo = 3 , & !: 2nd " " --> j … … 87 65 #else 88 66 ! global domain size !!! * global domain * 89 INTEGER & 90 #if !defined key_agrif 91 , PARAMETER & 92 #endif 93 :: & 67 INTEGER :: & 94 68 jpiglo = jpidta, & !: 1st dimension of global domain --> i 95 69 jpjglo = jpjdta, & !: 2nd " " --> j -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R4.h90
r2715 r4015 9 9 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 10 10 !!---------------------------------------------------------------------- 11 CHARACTER (len=16) & 12 #if !defined key_agrif 13 , PARAMETER & 14 #endif 15 :: & 16 cp_cfg = "orca" !: name of the configuration 17 INTEGER & 18 #if !defined key_agrif 19 , PARAMETER & 20 #endif 21 :: & 22 jp_cfg = 4 , & !: resolution of the configuration (degrees) 23 ! Original data size 11 CHARACTER (len=16) :: cp_cfg = "orca" !: name of the configuration 12 INTEGER :: jp_cfg = 4 !: resolution of the configuration (degrees) 13 INTEGER, PARAMETER :: & 14 ! data size !!! * size of all input files * 24 15 jpidta = 92 , & !: first horizontal dimension > or = to jpi 25 16 jpjdta = 76 , & !: second > or = to jpj 26 jpkdta = 31 , & !: number of levels > or = to jpk 17 jpkdta = 31 !: number of levels > or = to jpk 18 19 INTEGER :: & 27 20 ! global domain matrix size 28 21 jpiglo = jpidta, & !: first dimension of global domain --> i -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
r3294 r4015 7 7 !! NEMO 1.0 ! 2004-01 (G. Madec, J.-M. Molines) Free form and module 8 8 !! 3.3 ! 2010-09 (C. Ethe) TRA-TRC merge: add jpts, jp_tem & jp_sal 9 !! 3.5 ! 2012-07 (J. Simeon) online coarsening of outputs 10 !! renounced parameter status for jpiglo, jpjglo 9 11 !!---------------------------------------------------------------------- 10 12 USE par_kind ! kind parameters … … 90 92 !! default option : small closed basin 91 93 !!--------------------------------------------------------------------- 92 CHARACTER(len=16), PUBLIC , PARAMETER:: cp_cfg = "default" !: name of the configuration93 INTEGER , PUBLIC , PARAMETER:: jp_cfg = 0 !: resolution of the configuration94 CHARACTER(len=16), PUBLIC :: cp_cfg = "default" !: name of the configuration 95 INTEGER , PUBLIC :: jp_cfg = 0 !: resolution of the configuration 94 96 95 97 ! data size !!! * size of all input files * … … 98 100 INTEGER, PUBLIC, PARAMETER :: jpkdta = 31 !: number of levels ( >= jpk ) 99 101 100 ! global or zoom domain size 101 INTEGER, PUBLIC , PARAMETER:: jpiglo = jpidta !: 1st dimension of global domain --> i102 INTEGER, PUBLIC , PARAMETER:: jpjglo = jpjdta !: 2nd - - --> j102 ! global or zoom domain size (formerly parameters) !!! * computational domain * 103 INTEGER, PUBLIC :: jpiglo = jpidta !: 1st dimension of global domain --> i 104 INTEGER, PUBLIC :: jpjglo = jpjdta !: 2nd - - --> j 103 105 104 106 ! zoom starting position 105 INTEGER, PUBLIC , PARAMETER:: jpizoom = 1 !: left bottom (i,j) indices of the zoom106 INTEGER, PUBLIC , PARAMETER:: jpjzoom = 1 !: in data domain indices107 INTEGER, PUBLIC :: jpizoom = 1 !: left bottom (i,j) indices of the zoom 108 INTEGER, PUBLIC :: jpjzoom = 1 !: in data domain indices 107 109 108 110 ! Domain characteristics 109 INTEGER, PUBLIC , PARAMETER:: jperio = 0 !: lateral cond. type (between 0 and 6)111 INTEGER, PUBLIC :: jperio = 0 !: lateral cond. type (between 0 and 6) 110 112 ! ! = 0 closed ; = 1 cyclic East-West 111 113 ! ! = 2 equatorial symmetric ; = 3 North fold T-point pivot -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/step.F90
r3769 r4015 24 24 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 25 25 !! 3.4 ! 2011-04 (G. Madec, C. Ethe) Merge of dtatem and dtasal 26 !! ! 2012-07 (J. Simeon, G. Madec. C. Ethe) Online coarsening of outputs 26 27 !!---------------------------------------------------------------------- 27 28 … … 78 79 ! IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 79 80 # if defined key_iomput 80 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap 81 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( "nemo" ) 81 82 # endif 82 83 #endif 83 indic = 0 ! reset to no error condition 84 IF( kstp == nit000 ) CALL iom_init ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 84 indic = 0 ! reset to no error condition 85 IF( kstp == nit000 ) THEN 86 CALL iom_init( "nemo" ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 87 IF( ln_crs ) CALL iom_init( "nemo_crs" ) ! initialize context for coarse grid 88 ENDIF 85 89 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 86 CALL iom_setkt( kstp - nit000 + 1 ) ! say to iom that we are at time step kstp 90 CALL iom_setkt( kstp - nit000 + 1, "nemo" ) ! say to iom that we are at time step kstp 91 IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, "nemo_crs" ) ! say to iom that we are at time step kstp 87 92 88 93 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 170 175 IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis 171 176 CALL dia_wri( kstp ) ! ocean model: outputs 177 ! 178 IF( ln_crs ) CALL crs_fld( kstp ) ! ocean model: online field coarsening & output 179 172 180 173 181 #if defined key_top … … 270 278 IF( lk_cpl ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges 271 279 ! 272 #if defined key_iomput 273 IF( kstp == nitend ) CALL xios_context_finalize() ! needed for XIOS+AGRIF 274 #endif 280 IF( kstp == nitend ) THEN 281 CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF 282 IF( ln_crs ) CALL iom_context_finalize( "nemo_crs" ) ! 283 ENDIF 275 284 ! 276 285 IF( nn_timing == 1 .AND. kstp == nit000 ) CALL timing_reset -
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r3769 r4015 100 100 USE floats ! floats computation (flo_stp routine) 101 101 102 USE crsfld ! Standard output on coarse grid (crs_fld routine) 103 102 104 USE asminc ! assimilation increments (tra_asm_inc routine) 103 105 ! (dyn_asm_inc routine)
Note: See TracChangeset
for help on using the changeset viewer.