- Timestamp:
- 2014-12-02T10:38:20+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r4924 r4946 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 52 53 INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 47 #if ! defined key_oasis3 48 ! OASIS Variables not used. defined only for compilation purpose 49 INTEGER :: OASIS_Out = -1 50 INTEGER :: OASIS_REAL = -1 51 INTEGER :: OASIS_Ok = -1 52 INTEGER :: OASIS_In = -1 53 INTEGER :: OASIS_Sent = -1 54 INTEGER :: OASIS_SentOut = -1 55 INTEGER :: OASIS_ToRest = -1 56 INTEGER :: OASIS_ToRestOut = -1 57 INTEGER :: OASIS_Recvd = -1 58 INTEGER :: OASIS_RecvOut = -1 59 INTEGER :: OASIS_FromRest = -1 60 INTEGER :: OASIS_FromRestOut = -1 61 #endif 62 63 INTEGER, PUBLIC, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 64 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 65 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields 54 66 55 67 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information … … 58 70 CHARACTER(len = 1) :: clgrid ! Grid type 59 71 REAL(wp) :: nsgn ! Control of the sign change 60 INTEGER, DIMENSION( 9) :: nid ! Id of the field (no more than 9 categories)72 INTEGER, DIMENSION(nmaxcat,nmaxcpl) :: nid ! Id of the field (no more than 9 categories and 9 extrena models) 61 73 INTEGER :: nct ! Number of categories in field 74 INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received 62 75 END TYPE FLD_CPL 63 76 … … 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 application104 ! 1st Initialize the OASIS system for the application 92 105 !------------------------------------------------------------------ 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')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, kcplmodel ) 109 122 !!------------------------------------------------------------------- 110 !! *** ROUTINE cpl_ prism_define ***123 !! *** ROUTINE cpl_define *** 111 124 !! 112 125 !! ** Purpose : Define grid and field information for ocean … … 116 129 !!-------------------------------------------------------------------- 117 130 INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields 131 INTEGER, INTENT(in) :: kcplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 118 132 ! 119 133 INTEGER :: id_part 120 134 INTEGER :: paral(5) ! OASIS3 box partition 121 135 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe 122 INTEGER :: ji,jc ! local loop indicees 123 CHARACTER(LEN=8) :: zclname 136 INTEGER :: ji,jc,jm ! local loop indicees 137 CHARACTER(LEN=64) :: zclname 138 CHARACTER(LEN=2) :: cli2 124 139 !!-------------------------------------------------------------------- 125 140 126 141 IF(lwp) WRITE(numout,*) 127 IF(lwp) WRITE(numout,*) 'cpl_ prism_define : initialization in coupled ocean/atmosphere case'142 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' 128 143 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 129 144 IF(lwp) WRITE(numout,*) 130 145 146 IF( kcplmodel > nmaxcpl ) THEN 147 CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN 148 ENDIF 131 149 ! 132 150 ! ... Define the shape for the area that excludes the halo … … 141 159 ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 142 160 IF( nerror > 0 ) THEN 143 CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld') ; RETURN161 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN 144 162 ENDIF 145 163 ! … … 161 179 ENDIF 162 180 163 CALL prism_def_partition_proto( id_part, paral, nerror )181 CALL oasis_def_partition ( id_part, paral, nerror ) 164 182 ! 165 183 ! ... Announce send variables. 166 184 ! 185 ssnd(:)%ncplmodel = kcplmodel 186 ! 167 187 DO ji = 1, ksnd 168 IF ( ssnd(ji)%laction ) THEN 188 IF ( ssnd(ji)%laction ) THEN 189 190 IF( ssnd(ji)%nct > nmaxcat ) THEN 191 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 192 & TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 193 RETURN 194 ENDIF 195 169 196 DO jc = 1, ssnd(ji)%nct 170 IF ( ssnd(ji)%nct .gt. 1 ) THEN 171 WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 172 ELSE 173 zclname=ssnd(ji)%clname 174 ENDIF 175 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out 176 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 ) THEN 179 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') 181 ENDIF 197 DO jm = 1, kcplmodel 198 199 IF ( ssnd(ji)%nct .GT. 1 ) THEN 200 WRITE(cli2,'(i2.2)') jc 201 zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2 202 ELSE 203 zclname = ssnd(ji)%clname 204 ENDIF 205 IF ( kcplmodel > 1 ) THEN 206 WRITE(cli2,'(i2.2)') jm 207 zclname = 'model'//cli2//'_'//TRIM(zclname) 208 ENDIF 209 #if defined key_agrif 210 IF( agrif_fixed() /= 0 ) THEN 211 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 212 END IF 213 #endif 214 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 215 CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 216 & OASIS_Out , ishape , OASIS_REAL, nerror ) 217 IF ( nerror /= OASIS_Ok ) THEN 218 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 219 CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 220 ENDIF 221 IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 222 IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 223 END DO 182 224 END DO 183 225 ENDIF … … 188 230 DO ji = 1, krcv 189 231 IF ( srcv(ji)%laction ) THEN 232 233 IF( srcv(ji)%nct > nmaxcat ) THEN 234 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 235 & TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 236 RETURN 237 ENDIF 238 190 239 DO jc = 1, srcv(ji)%nct 191 IF ( srcv(ji)%nct .gt. 1 ) THEN 192 WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 193 ELSE 194 zclname=srcv(ji)%clname 195 ENDIF 196 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 197 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 ) THEN 200 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') 202 ENDIF 240 DO jm = 1, kcplmodel 241 242 IF ( srcv(ji)%nct .GT. 1 ) THEN 243 WRITE(cli2,'(i2.2)') jc 244 zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 245 ELSE 246 zclname = srcv(ji)%clname 247 ENDIF 248 IF ( kcplmodel > 1 ) THEN 249 WRITE(cli2,'(i2.2)') jm 250 zclname = 'model'//cli2//'_'//TRIM(zclname) 251 ENDIF 252 #if defined key_agrif 253 IF( agrif_fixed() /= 0 ) THEN 254 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 255 END IF 256 #endif 257 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 258 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 259 & OASIS_In , ishape , OASIS_REAL, nerror ) 260 IF ( nerror /= OASIS_Ok ) THEN 261 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 262 CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 263 ENDIF 264 IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 265 IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 266 267 END DO 203 268 END DO 204 269 ENDIF … … 209 274 !------------------------------------------------------------------ 210 275 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_define276 CALL oasis_enddef(nerror) 277 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 278 ! 279 END SUBROUTINE cpl_define 215 280 216 281 217 SUBROUTINE cpl_ prism_snd( kid, kstep, pdata, kinfo )282 SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 218 283 !!--------------------------------------------------------------------- 219 !! *** ROUTINE cpl_ prism_snd ***284 !! *** ROUTINE cpl_snd *** 220 285 !! 221 286 !! ** Purpose : - At each coupling time-step,this routine sends fields … … 227 292 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata 228 293 !! 229 INTEGER :: jc 294 INTEGER :: jc,jm ! local loop index 230 295 !!-------------------------------------------------------------------- 231 296 ! … … 233 298 ! 234 299 DO jc = 1, ssnd(kid)%nct 235 236 CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 237 238 IF ( ln_ctl ) THEN 239 IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. & 240 & kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN 241 WRITE(numout,*) '****************' 242 WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 243 WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc) 244 WRITE(numout,*) 'prism_put_proto: kstep ', kstep 245 WRITE(numout,*) 'prism_put_proto: info ', kinfo 246 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 247 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 248 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 249 WRITE(numout,*) '****************' 300 DO jm = 1, ssnd(kid)%ncplmodel 301 302 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 303 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 304 305 IF ( ln_ctl ) THEN 306 IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. & 307 & kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN 308 WRITE(numout,*) '****************' 309 WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname 310 WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm) 311 WRITE(numout,*) 'oasis_put: kstep ', kstep 312 WRITE(numout,*) 'oasis_put: info ', kinfo 313 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 314 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 315 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 316 WRITE(numout,*) '****************' 317 ENDIF 318 ENDIF 319 250 320 ENDIF 251 ENDIF252 321 322 ENDDO 253 323 ENDDO 254 324 ! 255 END SUBROUTINE cpl_ prism_snd256 257 258 SUBROUTINE cpl_ prism_rcv( kid, kstep, pdata, kinfo )325 END SUBROUTINE cpl_snd 326 327 328 SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo ) 259 329 !!--------------------------------------------------------------------- 260 !! *** ROUTINE cpl_ prism_rcv ***330 !! *** ROUTINE cpl_rcv *** 261 331 !! 262 332 !! ** Purpose : - At each coupling time-step,this routine receives fields … … 266 336 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 267 337 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done 338 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pmask ! coupling mask 268 339 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 269 340 !! 270 INTEGER :: jc 271 LOGICAL :: llaction 341 INTEGER :: jc,jm ! local loop index 342 LOGICAL :: llaction, llfisrt 272 343 !!-------------------------------------------------------------------- 273 344 ! 274 345 ! receive local data from OASIS3 on every process 275 346 ! 347 kinfo = OASIS_idle 348 ! 276 349 DO jc = 1, srcv(kid)%nct 277 278 CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo ) 279 280 llaction = .false. 281 IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. & 282 kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE. 283 284 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 285 286 IF ( llaction ) THEN 350 llfisrt = .TRUE. 351 352 DO jm = 1, srcv(kid)%ncplmodel 353 354 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 355 356 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 357 358 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 359 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 360 361 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 362 363 IF ( llaction ) THEN 364 365 kinfo = OASIS_Rcv 366 IF( llfisrt ) THEN 367 pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 368 llfisrt = .FALSE. 369 ELSE 370 pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 371 ENDIF 372 373 IF ( ln_ctl ) THEN 374 WRITE(numout,*) '****************' 375 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 376 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm) 377 WRITE(numout,*) 'oasis_get: kstep', kstep 378 WRITE(numout,*) 'oasis_get: info ', kinfo 379 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 380 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 381 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 382 WRITE(numout,*) '****************' 383 ENDIF 384 385 ENDIF 386 387 ENDIF 287 388 288 pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 289 290 !--- Fill the overlap areas and extra hallows (mpp) 291 !--- check periodicity conditions (all cases) 292 CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 293 294 IF ( ln_ctl ) THEN 295 WRITE(numout,*) '****************' 296 WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 297 WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid(jc) 298 WRITE(numout,*) 'prism_get_proto: kstep', kstep 299 WRITE(numout,*) 'prism_get_proto: info ', kinfo 300 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 301 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 302 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 303 WRITE(numout,*) '****************' 304 ENDIF 305 306 ! Ideally we would not reuse kinfo, but define a separate variable 307 ! for use as the return code from this routine to avoid confusion 308 ! with the return code previously obtained from the coupler. 309 kinfo = OASIS_Rcv 310 311 ELSE 312 kinfo = OASIS_idle 313 ENDIF 314 389 ENDDO 390 391 !--- Fill the overlap areas and extra hallows (mpp) 392 !--- check periodicity conditions (all cases) 393 IF( .not. llfisrt ) CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 394 315 395 ENDDO 316 396 ! 317 END SUBROUTINE cpl_ prism_rcv318 319 320 INTEGER FUNCTION cpl_ prism_freq( kid )397 END SUBROUTINE cpl_rcv 398 399 400 INTEGER FUNCTION cpl_freq( kid ) 321 401 !!--------------------------------------------------------------------- 322 !! *** ROUTINE cpl_ prism_freq ***402 !! *** ROUTINE cpl_freq *** 323 403 !! 324 404 !! ** Purpose : - send back the coupling frequency for a particular field 325 405 !!---------------------------------------------------------------------- 326 INTEGER,INTENT(in) :: kid ! variable index 406 INTEGER,INTENT(in) :: kid ! variable index 407 !! 408 INTEGER :: info 327 409 !!---------------------------------------------------------------------- 328 cpl_prism_freq = ig_def_freq( kid)329 ! 330 END FUNCTION cpl_ prism_freq331 332 333 SUBROUTINE cpl_ prism_finalize410 CALL oasis_get_freqs(kid, 1, cpl_freq, info) 411 ! 412 END FUNCTION cpl_freq 413 414 415 SUBROUTINE cpl_finalize 334 416 !!--------------------------------------------------------------------- 335 !! *** ROUTINE cpl_ prism_finalize ***417 !! *** ROUTINE cpl_finalize *** 336 418 !! 337 419 !! ** Purpose : - Finalizes the coupling. If MPI_init has not been 338 !! called explicitly before cpl_ prism_init it will also close420 !! called explicitly before cpl_init it will also close 339 421 !! MPI communication. 340 422 !!---------------------------------------------------------------------- 341 423 ! 342 424 DEALLOCATE( exfld ) 343 CALL prism_terminate_proto( nerror ) 344 ! 345 END SUBROUTINE cpl_prism_finalize 346 347 #else 348 !!---------------------------------------------------------------------- 349 !! Default case Dummy module Forced Ocean/Atmosphere 350 !!---------------------------------------------------------------------- 351 USE in_out_manager ! I/O manager 352 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE. !: coupled flag 353 PUBLIC cpl_prism_init 354 PUBLIC cpl_prism_finalize 355 CONTAINS 356 SUBROUTINE cpl_prism_init (kl_comm) 357 INTEGER, INTENT(out) :: kl_comm ! local communicator of the model 358 kl_comm = -1 359 WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 360 END SUBROUTINE cpl_prism_init 361 SUBROUTINE cpl_prism_finalize 362 WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' 363 END SUBROUTINE cpl_prism_finalize 425 IF (nstop == 0) THEN 426 CALL oasis_terminate( nerror ) 427 ELSE 428 CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 429 ENDIF 430 ! 431 END SUBROUTINE cpl_finalize 432 433 #if ! defined key_oasis3 434 435 !!---------------------------------------------------------------------- 436 !! No OASIS Library OASIS3 Dummy module... 437 !!---------------------------------------------------------------------- 438 439 SUBROUTINE oasis_init_comp(k1,cd1,k2) 440 CHARACTER(*), INTENT(in ) :: cd1 441 INTEGER , INTENT( out) :: k1,k2 442 k1 = -1 ; k2 = -1 443 WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1 444 END SUBROUTINE oasis_init_comp 445 446 SUBROUTINE oasis_abort(k1,cd1,cd2) 447 INTEGER , INTENT(in ) :: k1 448 CHARACTER(*), INTENT(in ) :: cd1,cd2 449 WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2 450 END SUBROUTINE oasis_abort 451 452 SUBROUTINE oasis_get_localcomm(k1,k2) 453 INTEGER , INTENT( out) :: k1,k2 454 k1 = -1 ; k2 = -1 455 WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...' 456 END SUBROUTINE oasis_get_localcomm 457 458 SUBROUTINE oasis_def_partition(k1,k2,k3) 459 INTEGER , INTENT( out) :: k1,k3 460 INTEGER , INTENT(in ) :: k2(5) 461 k1 = k2(1) ; k3 = k2(5) 462 WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...' 463 END SUBROUTINE oasis_def_partition 464 465 SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 466 CHARACTER(*), INTENT(in ) :: cd1 467 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(2,2),k6 468 INTEGER , INTENT( out) :: k1,k7 469 k1 = -1 ; k7 = -1 470 WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1 471 END SUBROUTINE oasis_def_var 472 473 SUBROUTINE oasis_enddef(k1) 474 INTEGER , INTENT( out) :: k1 475 k1 = -1 476 WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 477 END SUBROUTINE oasis_enddef 478 479 SUBROUTINE oasis_put(k1,k2,p1,k3) 480 REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1 481 INTEGER , INTENT(in ) :: k1,k2 482 INTEGER , INTENT( out) :: k3 483 k3 = -1 484 WRITE(numout,*) 'oasis_put: Error you sould not be there...' 485 END SUBROUTINE oasis_put 486 487 SUBROUTINE oasis_get(k1,k2,p1,k3) 488 REAL(wp), DIMENSION(:,:), INTENT( out) :: p1 489 INTEGER , INTENT(in ) :: k1,k2 490 INTEGER , INTENT( out) :: k3 491 p1(1,1) = -1. ; k3 = -1 492 WRITE(numout,*) 'oasis_get: Error you sould not be there...' 493 END SUBROUTINE oasis_get 494 495 SUBROUTINE oasis_get_freqs(k1,k2,k3,k4) 496 INTEGER , INTENT(in ) :: k1,k2 497 INTEGER , INTENT( out) :: k3,k4 498 k3 = k1 ; k4 = k2 499 WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...' 500 END SUBROUTINE oasis_get_freqs 501 502 SUBROUTINE oasis_terminate(k1) 503 INTEGER , INTENT( out) :: k1 504 k1 = -1 505 WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 506 END SUBROUTINE oasis_terminate 507 364 508 #endif 365 509
Note: See TracChangeset
for help on using the changeset viewer.
