Changeset 8731 for branches/UKMO
- Timestamp:
- 2017-11-17T12:37:29+01:00 (6 years ago)
- Location:
- branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 10 edited
-
DIA/diawri.F90 (modified) (1 diff)
-
LBC/lib_mpp.F90 (modified) (3 diffs)
-
SBC/cpl_oasis3.F90 (modified) (5 diffs)
-
SBC/geo2ocean.F90 (modified) (1 diff)
-
SBC/sbccpl.F90 (modified) (12 diffs)
-
SBC/sbcice_cice.F90 (modified) (2 diffs)
-
SBC/sbcmod.F90 (modified) (1 diff)
-
nemogcm.F90 (modified) (5 diffs)
-
step.F90 (modified) (2 diffs)
-
wrk_nemo.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r8730 r8731 1070 1070 ENDIF 1071 1071 #endif 1072 1073 IF (cdfile_name == "output.abort") THEN 1074 CALL ctl_stop('STOP', 'NEMO abort from dia_wri_state') 1075 END IF 1076 1072 1077 ! 1073 1078 END SUBROUTINE dia_wri_state -
branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r8730 r8731 2406 2406 2407 2407 SUBROUTINE mppstop 2408 2409 USE mod_oasis ! coupling routines 2410 2408 2411 !!---------------------------------------------------------------------- 2409 2412 !! *** routine mppstop *** … … 2415 2418 !!---------------------------------------------------------------------- 2416 2419 ! 2420 2421 #if defined key_oasis3 2422 ! If we're trying to shut down cleanly then we need to consider the fact 2423 ! that this could be part of an MPMD configuration - we don't want to 2424 ! leave other components deadlocked. 2425 2426 CALL oasis_abort(nproc,"mppstop","NEMO initiated abort") 2427 2428 2429 #else 2430 2417 2431 CALL mppsync 2418 2432 CALL mpi_finalize( info ) 2433 #endif 2434 2419 2435 ! 2420 2436 END SUBROUTINE mppstop … … 4333 4349 ENDIF 4334 4350 CALL FLUSH(kout) 4335 STOP 'ctl_opn bad opening'4351 CALL ctl_stop ('STOP', 'NEMO abort ctl_opn bad opening') 4336 4352 ENDIF 4337 4353 ! -
branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r8730 r8731 42 42 PUBLIC cpl_freq 43 43 PUBLIC cpl_finalize 44 #if defined key_mpp_mpi 45 INCLUDE 'mpif.h' 46 #endif 47 48 INTEGER, PARAMETER :: localRoot = 0 49 LOGICAL :: commRank ! true for ranks doing OASIS communication 50 #if defined key_cpl_rootexchg 51 LOGICAL :: rootexchg =.true. ! logical switch 52 #else 53 LOGICAL :: rootexchg =.false. ! logical switch 54 #endif 44 55 45 56 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field … … 83 94 84 95 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving 85 96 INTEGER, PUBLIC :: localComm 97 86 98 !!---------------------------------------------------------------------- 87 99 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 121 133 IF ( nerror /= OASIS_Ok ) & 122 134 CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 135 localComm = kl_comm 123 136 ! 124 137 END SUBROUTINE cpl_init … … 373 386 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 374 387 375 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 388 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 376 389 377 390 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & … … 463 476 CALL oasis_get_freqs(id, mop, 1, itmp, info) 464 477 #else 465 CALL oasis_get_freqs(id, 1, itmp, info)466 #endif 467 cpl_freq = itmp(1) 478 ! CALL oasis_get_freqs(id, 1, itmp, info) 479 cpl_freq = namflddti( id ) 480 #endif 468 481 ENDIF 469 482 ! -
branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r8730 r8731 51 51 !!---------------------------------------------------------------------- 52 52 CONTAINS 53 54 SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1, & 55 px2 , py2 , kchoix ) 56 !!---------------------------------------------------------------------- 57 !! *** ROUTINE repcmo *** 58 !! 59 !! ** Purpose : Change vector componantes from a geographic grid to a 60 !! stretched coordinates grid. 61 !! 62 !! ** Method : Initialization of arrays at the first call. 63 !! 64 !! ** Action : - px2 : first componante (defined at u point) 65 !! - py2 : second componante (defined at v point) 66 !!---------------------------------------------------------------------- 67 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pxu1, pyu1 ! geographic vector componantes at u-point 68 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pxv1, pyv1 ! geographic vector componantes at v-point 69 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: px2 ! i-componante (defined at u-point) 70 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: py2 ! j-componante (defined at v-point) 71 !!---------------------------------------------------------------------- 72 INTEGER, INTENT( IN ) :: & 73 kchoix ! type of transformation 74 ! = 1 change from geographic to model grid. 75 ! =-1 change from model to geographic grid 76 !!---------------------------------------------------------------------- 77 78 SELECT CASE (kchoix) 79 CASE ( 1) 80 ! Change from geographic to stretched coordinate 81 ! ---------------------------------------------- 82 83 CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 84 CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 85 CASE (-1) 86 ! Change from stretched to geographic coordinate 87 ! ---------------------------------------------- 88 89 CALL rot_rep( pxu1, pyu1, 'U', 'ij->e',px2 ) 90 CALL rot_rep( pxv1, pyv1, 'V', 'ij->n',py2 ) 91 END SELECT 92 93 END SUBROUTINE repcmo 53 94 54 95 SUBROUTINE rot_rep ( pxin, pyin, cd_type, cdtodo, prot ) -
branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8730 r8731 210 210 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 211 211 #endif 212 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 212 !ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 213 ! Hardwire only two models as nn_cplmodel has not been read in 214 ! from the namelist yet. 215 ALLOCATE( xcplmask(jpi,jpj,0:2) , STAT=ierr(3) ) 213 216 ! 214 217 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) … … 318 321 319 322 ! ! allocate sbccpl arrays 320 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )323 !IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 321 324 322 325 ! ================================ ! … … 382 385 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point 383 386 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 384 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 387 !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 388 ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 389 srcv(jpr_otx1)%laction = .TRUE. 390 srcv(jpr_oty1)%laction = .TRUE. 391 ! 385 392 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 386 393 CASE( 'T,I' ) … … 984 991 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 985 992 INTEGER :: ji, jj, jn ! dummy loop indices 986 INTEGER :: isec ! number of seconds since nit000 (assuming rdt did not change since nit000) 993 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 994 INTEGER :: ikchoix 987 995 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 988 996 REAL(wp) :: zcoef ! temporary scalar … … 990 998 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 991 999 REAL(wp) :: zzx, zzy ! temporary variables 992 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 1000 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 993 1001 !!---------------------------------------------------------------------- 994 1002 ! 995 1003 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 996 1004 ! 997 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr)1005 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 998 1006 ! 999 1007 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1033 1041 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 1034 1042 ! ! (geographical to local grid -> rotate the components) 1035 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1036 IF( srcv(jpr_otx2)%laction ) THEN 1037 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1038 ELSE 1039 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1043 IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 1044 ! Temporary code for HadGEM3 - will be removed eventually. 1045 ! Only applies when we have only taux on U grid and tauy on V grid 1046 DO jj=2,jpjm1 1047 DO ji=2,jpim1 1048 ztx(ji,jj)=0.25*vmask(ji,jj,1) & 1049 *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) & 1050 +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 1051 zty(ji,jj)=0.25*umask(ji,jj,1) & 1052 *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) & 1053 +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 1054 ENDDO 1055 ENDDO 1056 1057 ikchoix = 1 1058 CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 1059 CALL lbc_lnk (ztx2,'U', -1. ) 1060 CALL lbc_lnk (zty2,'V', -1. ) 1061 frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 1062 frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 1063 ELSE 1064 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1065 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 1066 IF( srcv(jpr_otx2)%laction ) THEN 1067 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1068 ELSE 1069 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1070 ENDIF 1071 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 1040 1072 ENDIF 1041 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid1042 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid1043 1073 ENDIF 1044 1074 ! … … 1311 1341 ENDIF 1312 1342 ! 1313 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr)1343 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 1314 1344 ! 1315 1345 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 1978 2008 ! 1979 2009 INTEGER :: ji, jj, jl ! dummy loop indices 2010 INTEGER :: ikchoix 1980 2011 INTEGER :: isec, info ! local integer 1981 2012 REAL(wp) :: zumax, zvmax … … 2156 2187 ! j+1 j -----V---F 2157 2188 ! surface velocity always sent from T point ! | 2158 ! 2189 ! [except for HadGEM3] j | T U 2159 2190 ! | | 2160 2191 ! j j-1 -I-------| … … 2168 2199 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2169 2200 CASE( 'oce only' ) ! C-grid ==> T 2170 DO jj = 2, jpjm1 2171 DO ji = fs_2, fs_jpim1 ! vector opt. 2172 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2173 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2201 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2202 DO jj = 2, jpjm1 2203 DO ji = fs_2, fs_jpim1 ! vector opt. 2204 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2205 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2206 END DO 2174 2207 END DO 2175 END DO 2208 ELSE 2209 ! Temporarily Changed for UKV 2210 DO jj = 2, jpjm1 2211 DO ji = 2, jpim1 2212 zotx1(ji,jj) = un(ji,jj,1) 2213 zoty1(ji,jj) = vn(ji,jj,1) 2214 END DO 2215 END DO 2216 ENDIF 2176 2217 CASE( 'weighted oce and ice' ) 2177 2218 SELECT CASE ( cp_ice_msh ) … … 2232 2273 END DO 2233 2274 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 2234 DO jj = 2, jpjm1 2235 DO ji = 2, jpim1 ! NO vector opt. 2236 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 2237 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 2238 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2239 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 2240 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 2241 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2275 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2276 DO jj = 2, jpjm1 2277 DO ji = 2, jpim1 ! NO vector opt. 2278 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj) & 2279 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 2280 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2281 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) * zfr_l(ji,jj) & 2282 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 2283 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2284 END DO 2242 2285 END DO 2243 END DO 2286 #if defined key_cice 2287 ELSE 2288 ! Temporarily Changed for HadGEM3 2289 DO jj = 2, jpjm1 2290 DO ji = 2, jpim1 ! NO vector opt. 2291 zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1) & 2292 & + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) ) 2293 zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1) & 2294 & + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) ) 2295 END DO 2296 END DO 2297 #endif 2298 ENDIF 2244 2299 END SELECT 2245 2300 END SELECT … … 2251 2306 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 2252 2307 ! ! Ocean component 2253 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2254 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2255 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2256 zoty1(:,:) = ztmp2(:,:) 2257 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2258 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2259 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2260 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2261 zity1(:,:) = ztmp2(:,:) 2262 ENDIF 2308 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2309 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2310 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2311 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2312 zoty1(:,:) = ztmp2(:,:) 2313 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2314 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2315 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2316 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2317 zity1(:,:) = ztmp2(:,:) 2318 ENDIF 2319 ELSE 2320 ! Temporary code for HadGEM3 - will be removed eventually. 2321 ! Only applies when we want uvel on U grid and vvel on V grid 2322 ! Rotate U and V onto geographic grid before sending. 2323 2324 DO jj=2,jpjm1 2325 DO ji=2,jpim1 2326 ztmp1(ji,jj)=0.25*vmask(ji,jj,1) & 2327 *(zotx1(ji,jj)+zotx1(ji-1,jj) & 2328 +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 2329 ztmp2(ji,jj)=0.25*umask(ji,jj,1) & 2330 *(zoty1(ji,jj)+zoty1(ji+1,jj) & 2331 +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 2332 ENDDO 2333 ENDDO 2334 2335 ! Ensure any N fold and wrap columns are updated 2336 CALL lbc_lnk(ztmp1, 'V', -1.0) 2337 CALL lbc_lnk(ztmp2, 'U', -1.0) 2338 2339 ikchoix = -1 2340 CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 2341 ENDIF 2263 2342 ENDIF 2264 2343 ! -
branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r8730 r8731 286 286 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 287 287 ! 288 ! In coupled mode get extra fields from CICE for passing back to atmosphere 289 290 IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(nit000) 291 ! 288 292 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_init') 289 293 ! … … 708 712 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_hadgam') 709 713 ! 710 IF( kt == nit000 ) THEN711 IF(lwp) WRITE(numout,*)'cice_sbc_hadgam'712 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )713 ENDIF714 715 714 ! ! =========================== ! 716 715 ! ! Prepare Coupling fields ! -
branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r8730 r8731 290 290 ! !* OASIS initialization 291 291 ! 292 IF( lk_oasis ) CALL sbc_cpl_init( nn_ice ) ! Must be done before: (1) first time step 293 ! ! (2) the use of nn_fsbc 292 IF( lk_oasis ) THEN 293 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 294 CALL sbc_cpl_init( nn_ice ) ! Must be done before: (1) first time step 295 ! (2) the use of nn_fsbc 296 ENDIF 294 297 ! nn_fsbc initialization if OPA-SAS coupling via OASIS 295 298 ! SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly -
branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r8730 r8731 90 90 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 91 91 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 92 USE sbccpl 92 93 #if defined key_iomput 93 94 USE xios ! xIOserver … … 181 182 #else 182 183 IF ( .NOT. ln_diurnal_only ) THEN 184 IF (lk_oasis) CALL sbc_cpl_snd( istp ) ! Coupling to atmos 183 185 CALL stp( istp ) ! standard time stepping 186 ! We don't couple on the final timestep because 187 ! our restart file has already been written 188 ! and contains all the necessary data for a 189 ! restart. sbc_cpl_snd could be called here 190 ! but it would require 191 ! a) A test to ensure it was not performed 192 ! on the very last time-step 193 ! b) the presence of another call to 194 ! sbc_cpl_snd call prior to the main DO loop 195 ! This solution produces identical results 196 ! with fewer lines of code. 184 197 ELSE 185 198 CALL stp_diurnal( istp ) ! time step only the diurnal SST … … 304 317 IF( Agrif_Root() ) THEN 305 318 IF( lk_oasis ) THEN 306 CALL cpl_init( " oceanx", ilocal_comm )! nemo local communicator given by oasis319 CALL cpl_init( "toyoce", ilocal_comm ) ! nemo local communicator given by oasis 307 320 CALL xios_initialize( "not used" ,local_comm= ilocal_comm ) ! send nemo communicator to xios 308 321 ELSE … … 315 328 IF( lk_oasis ) THEN 316 329 IF( Agrif_Root() ) THEN 317 CALL cpl_init( " oceanx", ilocal_comm )! nemo local communicator given by oasis330 CALL cpl_init( "toyoce", ilocal_comm ) ! nemo local communicator given by oasis 318 331 ENDIF 319 332 ! Nodes selection (control print return in cltxt) … … 516 529 CALL dia_tmb_init ! TMB outputs 517 530 CALL dia_25h_init ! 25h mean outputs 531 532 IF (nstop > 0) THEN 533 CALL CTL_STOP('STOP','Critical errors in NEMO initialisation') 534 END IF 535 518 536 ! 519 537 END SUBROUTINE nemo_init -
branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/step.F90
r8730 r8731 328 328 CALL ctl_stop( 'step: indic < 0' ) 329 329 CALL dia_wri_state( 'output.abort', kstp ) 330 CALL ctl_stop('STOP','NEMO failure in stp') 330 331 ENDIF 331 332 IF( kstp == nit000 ) THEN … … 339 340 ! Coupled mode 340 341 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 341 !!gm why lk_oasis and not lk_cpl ???? 342 IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges 342 !IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges 343 343 ! 344 344 #if defined key_iomput -
branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90
r8730 r8731 453 453 SUBROUTINE wrk_allocbase( kidim , kjdim , kkdim , kldim , kisrt , kjsrt , kksrt , klsrt , & 454 454 & kwrk1d, kwrk2d, kwrk3d, kwrk4d, pwrk1d, pwrk2d, pwrk3d, pwrk4d ) 455 USE in_out_manager, ONLY: numout 455 456 INTEGER , INTENT(in ) :: kidim, kjdim, kkdim, kldim 456 457 INTEGER , INTENT(in ) :: kisrt, kjsrt, kksrt, klsrt … … 483 484 & .AND. SUM( tree(ii)%ishape ) /= 0 ) 484 485 ii = ii + 1 485 IF (ii > jparray) STOP ! increase the value of jparray (should not be needed as already very big!) 486 IF (ii > jparray) THEN 487 WRITE(numout,*) "E R R O R: NEMO aborted wrk_allocbase" 488 FLUSH(numout) 489 STOP 'Increase the value of jparray' 490 ! increase the value of jparray (should not be needed as already very big!) 491 END IF 486 492 END DO 487 493
Note: See TracChangeset
for help on using the changeset viewer.
