Changeset 4857
- Timestamp:
- 2014-11-13T17:08:45+01:00 (9 years ago)
- Location:
- branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO
- Files:
-
- 2 deleted
- 6 edited
-
OOO_SRC/nemogcm.F90 (modified) (2 diffs)
-
OPA_SRC/SBC/cpl_oasis3.F90 (modified) (17 diffs)
-
OPA_SRC/SBC/cpl_oasis4.F90 (deleted)
-
OPA_SRC/SBC/oasis4_date.F90 (deleted)
-
OPA_SRC/SBC/sbccpl.F90 (modified) (14 diffs)
-
OPA_SRC/SBC/sbcice_cice.F90 (modified) (2 diffs)
-
OPA_SRC/SBC/sbcmod.F90 (modified) (2 diffs)
-
OPA_SRC/nemogcm.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90
r4624 r4857 54 54 USE icbini ! handle bergs, initialisation 55 55 USE icbstp ! handle bergs, calving, themodynamics and transport 56 #if defined key_oasis357 56 USE cpl_oasis3 ! OASIS3 coupling 58 #elif defined key_oasis459 USE cpl_oasis4 ! OASIS4 coupling (not working)60 #endif61 57 USE lib_mpp ! distributed memory computing 62 58 #if defined key_iomput … … 166 162 #if defined key_iomput 167 163 IF( Agrif_Root() ) THEN 168 # if defined key_oasis3 || defined key_oasis4 169 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 170 CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) 171 # else 172 CALL xios_initialize( "nemo",return_comm=ilocal_comm ) 173 # endif 164 IF( lk_cpl ) THEN 165 CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis 166 CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) ! send nemo communicator to xios 167 ELSE 168 CALL xios_initialize( "nemo",return_comm=ilocal_comm ) ! nemo local communicator given by xios 169 ENDIF 170 ENDIF 174 171 ENDIF 175 172 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 176 173 #else 177 # if defined key_oasis3 || defined key_oasis4 178 IF( Agrif_Root() ) THEN179 CALL cpl_prism_init( ilocal_comm )! nemo local communicator given by oasis180 ENDIF181 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt)182 # else 183 ilocal_comm = 0184 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)185 # endif 174 IF( lk_cpl ) THEN 175 IF( Agrif_Root() ) THEN 176 CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis 177 ENDIF 178 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 179 ELSE 180 ilocal_comm = 0 181 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 182 ENDIF 186 183 #endif 187 184 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) -
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r3294 r4857 2 2 !!====================================================================== 3 3 !! *** MODULE cpl_oasis *** 4 !! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4 5 !! special case: NEMO OPA/LIM coupled to ECHAM5 4 !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT 6 5 !!===================================================================== 7 6 !! History : … … 15 14 !! 3.4 ! 11-11 (C. Harris) Changes to allow mutiple category fields 16 15 !!---------------------------------------------------------------------- 16 !!---------------------------------------------------------------------- 17 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3 18 !!---------------------------------------------------------------------- 19 !! cpl_init : initialization of coupled mode communication 20 !! cpl_define : definition of grid and fields 21 !! cpl_snd : snd out fields in coupled mode 22 !! cpl_rcv : receive fields in coupled mode 23 !! cpl_finalize : finalize the coupled mode communication 24 !!---------------------------------------------------------------------- 17 25 #if defined key_oasis3 18 !!---------------------------------------------------------------------- 19 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3 20 !!---------------------------------------------------------------------- 21 !! cpl_prism_init : initialization of coupled mode communication 22 !! cpl_prism_define : definition of grid and fields 23 !! cpl_prism_snd : snd out fields in coupled mode 24 !! cpl_prism_rcv : receive fields in coupled mode 25 !! cpl_prism_finalize : finalize the coupled mode communication 26 !!---------------------------------------------------------------------- 27 USE mod_prism_proto ! OASIS3 prism module 28 USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning 29 USE mod_prism_put_proto ! OASIS3 prism module for snding 30 USE mod_prism_get_proto ! OASIS3 prism module for receiving 31 USE mod_comprism_proto ! OASIS3 prism module to get coupling frequency 26 USE mod_oasis ! OASIS3-MCT module 27 #endif 32 28 USE par_oce ! ocean parameters 33 29 USE dom_oce ! ocean space and time domain … … 38 34 PRIVATE 39 35 40 PUBLIC cpl_prism_init 41 PUBLIC cpl_prism_define 42 PUBLIC cpl_prism_snd 43 PUBLIC cpl_prism_rcv 44 PUBLIC cpl_prism_freq 45 PUBLIC cpl_prism_finalize 46 47 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE. !: coupled flag 36 PUBLIC cpl_init 37 PUBLIC cpl_define 38 PUBLIC cpl_snd 39 PUBLIC cpl_rcv 40 PUBLIC cpl_freq 41 PUBLIC cpl_finalize 42 48 43 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field 49 44 INTEGER, PUBLIC :: OASIS_idle = 0 !: return code if nothing done by oasis 50 INTEGER :: ncomp_id ! id returned by prism_init_comp45 INTEGER :: ncomp_id ! id returned by oasis_init_comp 51 46 INTEGER :: nerror ! return error code 47 #if defined key_oasis3 48 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE. !: coupled flag 49 #else 50 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE. !: coupled flag 51 ! OASIS Variables not used. defined only for compilation purpose 52 INTEGER :: OASIS_Out = -1 53 INTEGER :: OASIS_REAL = -1 54 INTEGER :: OASIS_Ok = -1 55 INTEGER :: OASIS_In = -1 56 INTEGER :: OASIS_Sent = -1 57 INTEGER :: OASIS_SentOut = -1 58 INTEGER :: OASIS_ToRest = -1 59 INTEGER :: OASIS_ToRestOut = -1 60 INTEGER :: OASIS_Recvd = -1 61 INTEGER :: OASIS_RecvOut = -1 62 INTEGER :: OASIS_FromRest = -1 63 INTEGER :: OASIS_FromRestOut = -1 64 #endif 52 65 53 66 INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields … … 73 86 CONTAINS 74 87 75 SUBROUTINE cpl_ prism_init( kl_comm )88 SUBROUTINE cpl_init( kl_comm ) 76 89 !!------------------------------------------------------------------- 77 !! *** ROUTINE cpl_ prism_init ***90 !! *** ROUTINE cpl_init *** 78 91 !! 79 92 !! ** Purpose : Initialize coupled mode communication for ocean … … 89 102 90 103 !------------------------------------------------------------------ 91 ! 1st Initialize the PRISMsystem for the application92 !------------------------------------------------------------------ 93 CALL prism_init_comp_proto( ncomp_id, 'oceanx', nerror )94 IF ( nerror /= PRISM_Ok ) &95 CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto')104 ! 1st Initialize the OASIS system for the application 105 !------------------------------------------------------------------ 106 CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror ) 107 IF ( nerror /= OASIS_Ok ) & 108 CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 96 109 97 110 !------------------------------------------------------------------ … … 99 112 !------------------------------------------------------------------ 100 113 101 CALL prism_get_localcomm_proto( kl_comm, nerror )102 IF ( nerror /= PRISM_Ok ) &103 CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' )104 ! 105 END SUBROUTINE cpl_ prism_init106 107 108 SUBROUTINE cpl_ prism_define( krcv, ksnd )114 CALL oasis_get_localcomm ( kl_comm, nerror ) 115 IF ( nerror /= OASIS_Ok ) & 116 CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 117 ! 118 END SUBROUTINE cpl_init 119 120 121 SUBROUTINE cpl_define( krcv, ksnd ) 109 122 !!------------------------------------------------------------------- 110 !! *** ROUTINE cpl_ prism_define ***123 !! *** ROUTINE cpl_define *** 111 124 !! 112 125 !! ** Purpose : Define grid and field information for ocean … … 125 138 126 139 IF(lwp) WRITE(numout,*) 127 IF(lwp) WRITE(numout,*) 'cpl_ prism_define : initialization in coupled ocean/atmosphere case'140 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' 128 141 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 129 142 IF(lwp) WRITE(numout,*) … … 141 154 ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 142 155 IF( nerror > 0 ) THEN 143 CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld') ; RETURN156 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN 144 157 ENDIF 145 158 ! … … 161 174 ENDIF 162 175 163 CALL prism_def_partition_proto( id_part, paral, nerror )176 CALL oasis_def_partition ( id_part, paral, nerror ) 164 177 ! 165 178 ! ... Announce send variables. … … 173 186 zclname=ssnd(ji)%clname 174 187 ENDIF 175 WRITE(numout,*) "Define",ji,jc,zclname," for", PRISM_Out176 CALL prism_def_var_proto(ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/), &177 PRISM_Out, ishape, PRISM_REAL, nerror)178 IF ( nerror /= PRISM_Ok ) THEN188 WRITE(numout,*) "Define",ji,jc,zclname," for",OASIS_Out 189 CALL oasis_def_var (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 190 OASIS_Out, ishape, OASIS_REAL, nerror) 191 IF ( nerror /= OASIS_Ok ) THEN 179 192 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 180 CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var')193 CALL oasis_abort ( ssnd(ji)%nid(jc), 'cpl_define', 'Failure in oasis_def_var') 181 194 ENDIF 182 195 END DO … … 194 207 zclname=srcv(ji)%clname 195 208 ENDIF 196 WRITE(numout,*) "Define",ji,jc,zclname," for", PRISM_In197 CALL prism_def_var_proto( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/), &198 & PRISM_In , ishape , PRISM_REAL, nerror)199 IF ( nerror /= PRISM_Ok ) THEN209 WRITE(numout,*) "Define",ji,jc,zclname," for",OASIS_In 210 CALL oasis_def_var ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 211 & OASIS_In , ishape , OASIS_REAL, nerror) 212 IF ( nerror /= OASIS_Ok ) THEN 200 213 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 201 CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var')214 CALL oasis_abort ( srcv(ji)%nid(jc), 'cpl_define', 'Failure in oasis_def_var') 202 215 ENDIF 203 216 END DO … … 209 222 !------------------------------------------------------------------ 210 223 211 CALL prism_enddef_proto(nerror)212 IF( nerror /= PRISM_Ok ) CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')213 ! 214 END SUBROUTINE cpl_ prism_define224 CALL oasis_enddef(nerror) 225 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 226 ! 227 END SUBROUTINE cpl_define 215 228 216 229 217 SUBROUTINE cpl_ prism_snd( kid, kstep, pdata, kinfo )230 SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 218 231 !!--------------------------------------------------------------------- 219 !! *** ROUTINE cpl_ prism_snd ***232 !! *** ROUTINE cpl_snd *** 220 233 !! 221 234 !! ** Purpose : - At each coupling time-step,this routine sends fields … … 234 247 DO jc = 1, ssnd(kid)%nct 235 248 236 CALL prism_put_proto( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )249 CALL oasis_put ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 237 250 238 251 IF ( ln_ctl ) THEN 239 IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. &240 & kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN252 IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. & 253 & kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN 241 254 WRITE(numout,*) '****************' 242 WRITE(numout,*) ' prism_put_proto: Outgoing ', ssnd(kid)%clname243 WRITE(numout,*) ' prism_put_proto: ivarid ', ssnd(kid)%nid(jc)244 WRITE(numout,*) ' prism_put_proto: kstep ', kstep245 WRITE(numout,*) ' prism_put_proto: info ', kinfo255 WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname 256 WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc) 257 WRITE(numout,*) 'oasis_put: kstep ', kstep 258 WRITE(numout,*) 'oasis_put: info ', kinfo 246 259 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 247 260 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) … … 253 266 ENDDO 254 267 ! 255 END SUBROUTINE cpl_ prism_snd256 257 258 SUBROUTINE cpl_ prism_rcv( kid, kstep, pdata, kinfo )268 END SUBROUTINE cpl_snd 269 270 271 SUBROUTINE cpl_rcv( kid, kstep, pdata, kinfo ) 259 272 !!--------------------------------------------------------------------- 260 !! *** ROUTINE cpl_ prism_rcv ***273 !! *** ROUTINE cpl_rcv *** 261 274 !! 262 275 !! ** Purpose : - At each coupling time-step,this routine receives fields … … 276 289 DO jc = 1, srcv(kid)%nct 277 290 278 CALL prism_get_proto( srcv(kid)%nid(jc), kstep, exfld, kinfo )291 CALL oasis_get ( srcv(kid)%nid(jc), kstep, exfld, kinfo ) 279 292 280 293 llaction = .false. 281 IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. &282 kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE.294 IF( kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 295 kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut ) llaction = .TRUE. 283 296 284 297 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) … … 295 308 IF ( ln_ctl ) THEN 296 309 WRITE(numout,*) '****************' 297 WRITE(numout,*) ' prism_get_proto: Incoming ', srcv(kid)%clname298 WRITE(numout,*) ' prism_get_proto: ivarid ' , srcv(kid)%nid(jc)299 WRITE(numout,*) ' prism_get_proto: kstep', kstep300 WRITE(numout,*) ' prism_get_proto: info ', kinfo310 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 311 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc) 312 WRITE(numout,*) 'oasis_get: kstep', kstep 313 WRITE(numout,*) 'oasis_get: info ', kinfo 301 314 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 302 315 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) … … 311 324 ENDDO 312 325 ! 313 END SUBROUTINE cpl_ prism_rcv314 315 316 INTEGER FUNCTION cpl_ prism_freq( kid )326 END SUBROUTINE cpl_rcv 327 328 329 INTEGER FUNCTION cpl_freq( kid ) 317 330 !!--------------------------------------------------------------------- 318 !! *** ROUTINE cpl_ prism_freq ***331 !! *** ROUTINE cpl_freq *** 319 332 !! 320 333 !! ** Purpose : - send back the coupling frequency for a particular field 321 334 !!---------------------------------------------------------------------- 322 INTEGER,INTENT(in) :: kid ! variable index 335 INTEGER,INTENT(in) :: kid ! variable index 336 !! 337 INTEGER :: info 323 338 !!---------------------------------------------------------------------- 324 cpl_prism_freq = ig_def_freq( kid)325 ! 326 END FUNCTION cpl_ prism_freq327 328 329 SUBROUTINE cpl_ prism_finalize339 CALL oasis_get_freqs(kid, 1, cpl_freq, info) 340 ! 341 END FUNCTION cpl_freq 342 343 344 SUBROUTINE cpl_finalize 330 345 !!--------------------------------------------------------------------- 331 !! *** ROUTINE cpl_ prism_finalize ***346 !! *** ROUTINE cpl_finalize *** 332 347 !! 333 348 !! ** Purpose : - Finalizes the coupling. If MPI_init has not been 334 !! called explicitly before cpl_ prism_init it will also close349 !! called explicitly before cpl_init it will also close 335 350 !! MPI communication. 336 351 !!---------------------------------------------------------------------- 337 352 ! 338 353 DEALLOCATE( exfld ) 339 CALL prism_terminate_proto( nerror ) 340 ! 341 END SUBROUTINE cpl_prism_finalize 342 343 #else 344 !!---------------------------------------------------------------------- 345 !! Default case Dummy module Forced Ocean/Atmosphere 346 !!---------------------------------------------------------------------- 347 USE in_out_manager ! I/O manager 348 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE. !: coupled flag 349 PUBLIC cpl_prism_init 350 PUBLIC cpl_prism_finalize 351 CONTAINS 352 SUBROUTINE cpl_prism_init (kl_comm) 353 INTEGER, INTENT(out) :: kl_comm ! local communicator of the model 354 kl_comm = -1 355 WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 356 END SUBROUTINE cpl_prism_init 357 SUBROUTINE cpl_prism_finalize 358 WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' 359 END SUBROUTINE cpl_prism_finalize 354 IF (nstop == 0) THEN 355 CALL oasis_terminate( nerror ) 356 ELSE 357 CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 358 ENDIF 359 ! 360 END SUBROUTINE cpl_finalize 361 362 #if ! defined key_oasis3 363 364 !!---------------------------------------------------------------------- 365 !! No OASIS Library OASIS3 Dummy module... 366 !!---------------------------------------------------------------------- 367 368 SUBROUTINE oasis_init_comp(k1,cd1,k2) 369 CHARACTER(*), INTENT(in ) :: cd1 370 INTEGER , INTENT( out) :: k1,k2 371 k1 = -1 ; k2 = -1 372 WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1 373 END SUBROUTINE oasis_init_comp 374 375 SUBROUTINE oasis_abort(k1,cd1,cd2) 376 INTEGER , INTENT(in ) :: k1 377 CHARACTER(*), INTENT(in ) :: cd1,cd2 378 WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2 379 END SUBROUTINE oasis_abort 380 381 SUBROUTINE oasis_get_localcomm(k1,k2) 382 INTEGER , INTENT( out) :: k1,k2 383 k1 = -1 ; k2 = -1 384 WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...' 385 END SUBROUTINE oasis_get_localcomm 386 387 SUBROUTINE oasis_def_partition(k1,k2,k3) 388 INTEGER , INTENT( out) :: k1,k3 389 INTEGER , INTENT(in ) :: k2(5) 390 k1 = k2(1) ; k3 = k2(5) 391 WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...' 392 END SUBROUTINE oasis_def_partition 393 394 SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 395 CHARACTER(*), INTENT(in ) :: cd1 396 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(2,2),k6 397 INTEGER , INTENT( out) :: k1,k7 398 k1 = -1 ; k7 = -1 399 WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1 400 END SUBROUTINE oasis_def_var 401 402 SUBROUTINE oasis_enddef(k1) 403 INTEGER , INTENT( out) :: k1 404 k1 = -1 405 WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 406 END SUBROUTINE oasis_enddef 407 408 SUBROUTINE oasis_put(k1,k2,p1,k3) 409 REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1 410 INTEGER , INTENT(in ) :: k1,k2 411 INTEGER , INTENT( out) :: k3 412 k3 = -1 413 WRITE(numout,*) 'oasis_put: Error you sould not be there...' 414 END SUBROUTINE oasis_put 415 416 SUBROUTINE oasis_get(k1,k2,p1,k3) 417 REAL(wp), DIMENSION(:,:), INTENT( out) :: p1 418 INTEGER , INTENT(in ) :: k1,k2 419 INTEGER , INTENT( out) :: k3 420 p1(1,1) = -1. ; k3 = -1 421 WRITE(numout,*) 'oasis_get: Error you sould not be there...' 422 END SUBROUTINE oasis_get 423 424 SUBROUTINE oasis_get_freqs(k1,k2,k3,k4) 425 INTEGER , INTENT(in ) :: k1,k2 426 INTEGER , INTENT( out) :: k3,k4 427 k3 = k1 ; k4 = k2 428 WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...' 429 END SUBROUTINE oasis_get_freqs 430 431 SUBROUTINE oasis_terminate(k1) 432 INTEGER , INTENT( out) :: k1 433 k1 = -1 434 WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 435 END SUBROUTINE oasis_terminate 436 360 437 #endif 361 438 -
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r4733 r4857 9 9 !! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields 10 10 !!---------------------------------------------------------------------- 11 #if defined key_oasis3 || defined key_oasis412 !!----------------------------------------------------------------------13 !! 'key_oasis3' or 'key_oasis4' Coupled Ocean/Atmosphere formulation14 11 !!---------------------------------------------------------------------- 15 12 !! namsbc_cpl : coupled formulation namlist … … 34 31 USE ice_2 ! ice variables 35 32 #endif 36 #if defined key_oasis337 33 USE cpl_oasis3 ! OASIS3 coupling 38 #endif39 #if defined key_oasis440 USE cpl_oasis4 ! OASIS4 coupling41 #endif42 34 USE geo2ocean ! 43 35 USE oce , ONLY : tsn, un, vn … … 58 50 IMPLICIT NONE 59 51 PRIVATE 60 52 !EM XIOS-OASIS-MCT compliance 53 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 61 54 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 62 55 PUBLIC sbc_cpl_snd ! routine called by step.F90 … … 604 597 ! ================================ ! 605 598 606 CALL cpl_ prism_define(jprcv, jpsnd)607 ! 608 IF( ln_dm2dc .AND. ( cpl_ prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) ) &599 CALL cpl_define(jprcv, jpsnd) 600 ! 601 IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) ) & 609 602 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 610 603 … … 678 671 ! 679 672 CALL wrk_alloc( jpi,jpj, ztx, zty ) 680 681 IF( kt == nit000 ) CALL sbc_cpl_init( k_ice ) ! initialisation682 683 673 ! ! Receive all the atmos. fields (including ice information) 684 674 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 685 675 DO jn = 1, jprcv ! received fields sent by the atmosphere 686 IF( srcv(jn)%laction ) CALL cpl_ prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) )676 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 687 677 END DO 688 678 … … 1334 1324 !! ** Purpose : provide the ocean-ice informations to the atmosphere 1335 1325 !! 1336 !! ** Method : send to the atmosphere through a call to cpl_ prism_snd1326 !! ** Method : send to the atmosphere through a call to cpl_snd 1337 1327 !! all the needed fields (as defined in sbc_cpl_init) 1338 1328 !!---------------------------------------------------------------------- … … 1378 1368 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1379 1369 END SELECT 1380 IF( ssnd(jps_toce)%laction ) CALL cpl_ prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )1381 IF( ssnd(jps_tice)%laction ) CALL cpl_ prism_snd( jps_tice, isec, ztmp3, info )1382 IF( ssnd(jps_tmix)%laction ) CALL cpl_ prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )1370 IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1371 IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info ) 1372 IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1383 1373 ENDIF 1384 1374 ! … … 1388 1378 IF( ssnd(jps_albice)%laction ) THEN ! ice 1389 1379 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1390 CALL cpl_ prism_snd( jps_albice, isec, ztmp3, info )1380 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1391 1381 ENDIF 1392 1382 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean … … 1395 1385 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 1396 1386 ENDDO 1397 CALL cpl_ prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )1387 CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1398 1388 ENDIF 1399 1389 ! ! ------------------------- ! … … 1407 1397 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1408 1398 END SELECT 1409 CALL cpl_ prism_snd( jps_fice, isec, ztmp3, info )1399 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1410 1400 ENDIF 1411 1401 … … 1432 1422 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1433 1423 END SELECT 1434 IF( ssnd(jps_hice)%laction ) CALL cpl_ prism_snd( jps_hice, isec, ztmp3, info )1435 IF( ssnd(jps_hsnw)%laction ) CALL cpl_ prism_snd( jps_hsnw, isec, ztmp4, info )1424 IF( ssnd(jps_hice)%laction ) CALL cpl_snd( jps_hice, isec, ztmp3, info ) 1425 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 1436 1426 ENDIF 1437 1427 ! … … 1440 1430 ! ! CO2 flux from PISCES ! 1441 1431 ! ! ------------------------- ! 1442 IF( ssnd(jps_co2)%laction ) CALL cpl_ prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )1432 IF( ssnd(jps_co2)%laction ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 1443 1433 ! 1444 1434 #endif … … 1563 1553 ENDIF 1564 1554 ! 1565 IF( ssnd(jps_ocx1)%laction ) CALL cpl_ prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid1566 IF( ssnd(jps_ocy1)%laction ) CALL cpl_ prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid1567 IF( ssnd(jps_ocz1)%laction ) CALL cpl_ prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid1555 IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 1556 IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 1557 IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid 1568 1558 ! 1569 IF( ssnd(jps_ivx1)%laction ) CALL cpl_ prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid1570 IF( ssnd(jps_ivy1)%laction ) CALL cpl_ prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid1571 IF( ssnd(jps_ivz1)%laction ) CALL cpl_ prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid1559 IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid 1560 IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid 1561 IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid 1572 1562 ! 1573 1563 ENDIF … … 1580 1570 END SUBROUTINE sbc_cpl_snd 1581 1571 1582 #else1583 !!----------------------------------------------------------------------1584 !! Dummy module NO coupling1585 !!----------------------------------------------------------------------1586 USE par_kind ! kind definition1587 CONTAINS1588 SUBROUTINE sbc_cpl_snd( kt )1589 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt1590 END SUBROUTINE sbc_cpl_snd1591 !1592 SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )1593 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt, k_fsbc, k_ice1594 END SUBROUTINE sbc_cpl_rcv1595 !1596 SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )1597 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]1598 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)1599 p_taui(:,:) = 0. ; p_tauj(:,:) = 0. ! stupid definition to avoid warning message when compiling...1600 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?'1601 END SUBROUTINE sbc_cpl_ice_tau1602 !1603 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist )1604 REAL(wp), INTENT(in ), DIMENSION(:,: ) :: p_frld ! lead fraction [0 to 1]1605 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo1606 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius]1607 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]1608 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)1609 END SUBROUTINE sbc_cpl_ice_flx1610 1611 #endif1612 1613 1572 !!====================================================================== 1614 1573 END MODULE sbccpl -
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r4627 r4857 611 611 612 612 613 #if defined key_oasis3 || defined key_oasis4614 613 SUBROUTINE cice_sbc_hadgam( kt ) 615 614 !!--------------------------------------------------------------------- … … 653 652 END SUBROUTINE cice_sbc_hadgam 654 653 655 #else656 SUBROUTINE cice_sbc_hadgam( kt ) ! Dummy routine657 INTEGER, INTENT( in ) :: kt ! ocean time step658 WRITE(*,*) 'cice_sbc_hadgam: You should not have seen this print! error?'659 END SUBROUTINE cice_sbc_hadgam660 #endif661 654 662 655 SUBROUTINE cice_sbc_final -
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r4733 r4857 265 265 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation 266 266 ! 267 IF( nsbc == 5 ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before first time step 268 267 269 END SUBROUTINE sbc_init 268 270 … … 337 339 CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM-2 ice model 338 340 CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc ) ! LIM-3 ice model 339 !is it useful?340 341 CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model 341 342 END SELECT -
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r4723 r4857 69 69 USE icbini ! handle bergs, initialisation 70 70 USE icbstp ! handle bergs, calving, themodynamics and transport 71 #if defined key_oasis372 71 USE cpl_oasis3 ! OASIS3 coupling 73 #elif defined key_oasis474 USE cpl_oasis4 ! OASIS4 coupling (not working)75 #endif76 72 USE c1d ! 1D configuration 77 73 USE step_c1d ! Time stepping loop for the 1D configuration … … 201 197 ! 202 198 CALL nemo_closefile 199 ! 203 200 #if defined key_iomput 204 201 CALL xios_finalize ! end mpp communications with xios 205 # if defined key_oasis3 || defined key_oasis4 206 CALL cpl_prism_finalize ! end coupling and mpp communications with OASIS 207 # endif 202 IF( lk_cpl ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 208 203 #else 209 # if defined key_oasis3 || defined key_oasis4 210 CALL cpl_prism_finalize! end coupling and mpp communications with OASIS211 # else 212 IF( lk_mpp ) CALL mppstop! end mpp communications213 # endif 204 IF( lk_cpl ) THEN 205 CALL cpl_finalize ! end coupling and mpp communications with OASIS 206 ELSE 207 IF( lk_mpp ) CALL mppstop ! end mpp communications 208 ENDIF 214 209 #endif 215 210 ! … … 281 276 #if defined key_iomput 282 277 IF( Agrif_Root() ) THEN 283 # if defined key_oasis3 || defined key_oasis4 284 CALL cpl_prism_init( ilocal_comm )! nemo local communicator given by oasis285 CALL xios_initialize( "oceanx",local_comm=ilocal_comm )286 # else 287 CALL xios_initialize( "nemo",return_comm=ilocal_comm )288 # endif 278 IF( lk_cpl ) THEN 279 CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis 280 CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) ! send nemo communicator to xios 281 ELSE 282 CALL xios_initialize( "nemo",return_comm=ilocal_comm ) ! nemo local communicator given by xios 283 ENDIF 289 284 ENDIF 290 285 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 291 286 #else 292 # if defined key_oasis3 || defined key_oasis4 293 IF( Agrif_Root() ) THEN294 CALL cpl_prism_init( ilocal_comm )! nemo local communicator given by oasis295 ENDIF296 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt)297 # else 298 ilocal_comm = 0299 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )! Nodes selection (control print return in cltxt)300 # endif 287 IF( lk_cpl ) THEN 288 IF( Agrif_Root() ) THEN 289 CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis 290 ENDIF 291 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 292 ELSE 293 ilocal_comm = 0 294 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 295 ENDIF 301 296 #endif 302 297 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )
Note: See TracChangeset
for help on using the changeset viewer.
