Changeset 5208 for branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
- Timestamp:
- 2015-04-13T15:08:59+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r3294 r5208 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 … … 186 228 ! ... Announce received variables. 187 229 ! 230 srcv(:)%ncplmodel = kcplmodel 231 ! 188 232 DO ji = 1, krcv 189 233 IF ( srcv(ji)%laction ) THEN 234 235 IF( srcv(ji)%nct > nmaxcat ) THEN 236 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 237 & TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 238 RETURN 239 ENDIF 240 190 241 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 242 DO jm = 1, kcplmodel 243 244 IF ( srcv(ji)%nct .GT. 1 ) THEN 245 WRITE(cli2,'(i2.2)') jc 246 zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 247 ELSE 248 zclname = srcv(ji)%clname 249 ENDIF 250 IF ( kcplmodel > 1 ) THEN 251 WRITE(cli2,'(i2.2)') jm 252 zclname = 'model'//cli2//'_'//TRIM(zclname) 253 ENDIF 254 #if defined key_agrif 255 IF( agrif_fixed() /= 0 ) THEN 256 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 257 END IF 258 #endif 259 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 260 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 261 & OASIS_In , ishape , OASIS_REAL, nerror ) 262 IF ( nerror /= OASIS_Ok ) THEN 263 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 264 CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 265 ENDIF 266 IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 267 IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 268 269 END DO 203 270 END DO 204 271 ENDIF … … 209 276 !------------------------------------------------------------------ 210 277 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_define278 CALL oasis_enddef(nerror) 279 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 280 ! 281 END SUBROUTINE cpl_define 215 282 216 283 217 SUBROUTINE cpl_ prism_snd( kid, kstep, pdata, kinfo )284 SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 218 285 !!--------------------------------------------------------------------- 219 !! *** ROUTINE cpl_ prism_snd ***286 !! *** ROUTINE cpl_snd *** 220 287 !! 221 288 !! ** Purpose : - At each coupling time-step,this routine sends fields … … 227 294 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata 228 295 !! 229 INTEGER :: jc 296 INTEGER :: jc,jm ! local loop index 230 297 !!-------------------------------------------------------------------- 231 298 ! … … 233 300 ! 234 301 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,*) '****************' 302 DO jm = 1, ssnd(kid)%ncplmodel 303 304 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 305 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 306 307 IF ( ln_ctl ) THEN 308 IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. & 309 & kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN 310 WRITE(numout,*) '****************' 311 WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname 312 WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm) 313 WRITE(numout,*) 'oasis_put: kstep ', kstep 314 WRITE(numout,*) 'oasis_put: info ', kinfo 315 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 316 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 317 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 318 WRITE(numout,*) '****************' 319 ENDIF 320 ENDIF 321 250 322 ENDIF 251 ENDIF252 323 324 ENDDO 253 325 ENDDO 254 326 ! 255 END SUBROUTINE cpl_ prism_snd256 257 258 SUBROUTINE cpl_ prism_rcv( kid, kstep, pdata, kinfo )327 END SUBROUTINE cpl_snd 328 329 330 SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo ) 259 331 !!--------------------------------------------------------------------- 260 !! *** ROUTINE cpl_ prism_rcv ***332 !! *** ROUTINE cpl_rcv *** 261 333 !! 262 334 !! ** Purpose : - At each coupling time-step,this routine receives fields … … 266 338 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 267 339 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done 340 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pmask ! coupling mask 268 341 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 269 342 !! 270 INTEGER :: jc 271 LOGICAL :: llaction 343 INTEGER :: jc,jm ! local loop index 344 LOGICAL :: llaction, llfisrt 272 345 !!-------------------------------------------------------------------- 273 346 ! 274 347 ! receive local data from OASIS3 on every process 275 348 ! 349 kinfo = OASIS_idle 350 ! 276 351 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 287 288 kinfo = OASIS_Rcv 289 pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 290 291 !--- Fill the overlap areas and extra hallows (mpp) 292 !--- check periodicity conditions (all cases) 293 CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 294 295 IF ( ln_ctl ) THEN 296 WRITE(numout,*) '****************' 297 WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 298 WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid(jc) 299 WRITE(numout,*) 'prism_get_proto: kstep', kstep 300 WRITE(numout,*) 'prism_get_proto: info ', kinfo 301 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 302 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 303 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 304 WRITE(numout,*) '****************' 352 llfisrt = .TRUE. 353 354 DO jm = 1, srcv(kid)%ncplmodel 355 356 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 357 358 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 359 360 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 361 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 362 363 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 364 365 IF ( llaction ) THEN 366 367 kinfo = OASIS_Rcv 368 IF( llfisrt ) THEN 369 pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 370 llfisrt = .FALSE. 371 ELSE 372 pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 373 ENDIF 374 375 IF ( ln_ctl ) THEN 376 WRITE(numout,*) '****************' 377 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 378 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm) 379 WRITE(numout,*) 'oasis_get: kstep', kstep 380 WRITE(numout,*) 'oasis_get: info ', kinfo 381 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 382 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 383 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 384 WRITE(numout,*) '****************' 385 ENDIF 386 387 ENDIF 388 305 389 ENDIF 306 390 307 ELSE 308 kinfo = OASIS_idle 309 ENDIF 310 391 ENDDO 392 393 !--- Fill the overlap areas and extra hallows (mpp) 394 !--- check periodicity conditions (all cases) 395 IF( .not. llfisrt ) CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 396 311 397 ENDDO 312 398 ! 313 END SUBROUTINE cpl_ prism_rcv314 315 316 INTEGER FUNCTION cpl_ prism_freq( kid )399 END SUBROUTINE cpl_rcv 400 401 402 INTEGER FUNCTION cpl_freq( kid ) 317 403 !!--------------------------------------------------------------------- 318 !! *** ROUTINE cpl_ prism_freq ***404 !! *** ROUTINE cpl_freq *** 319 405 !! 320 406 !! ** Purpose : - send back the coupling frequency for a particular field 321 407 !!---------------------------------------------------------------------- 322 INTEGER,INTENT(in) :: kid ! variable index 408 INTEGER,INTENT(in) :: kid ! variable index 409 !! 410 INTEGER :: info 411 INTEGER, DIMENSION(1) :: itmp 323 412 !!---------------------------------------------------------------------- 324 cpl_prism_freq = ig_def_freq( kid ) 325 ! 326 END FUNCTION cpl_prism_freq 327 328 329 SUBROUTINE cpl_prism_finalize 413 CALL oasis_get_freqs(kid, 1, itmp, info) 414 cpl_freq = itmp(1) 415 ! 416 END FUNCTION cpl_freq 417 418 419 SUBROUTINE cpl_finalize 330 420 !!--------------------------------------------------------------------- 331 !! *** ROUTINE cpl_ prism_finalize ***421 !! *** ROUTINE cpl_finalize *** 332 422 !! 333 423 !! ** Purpose : - Finalizes the coupling. If MPI_init has not been 334 !! called explicitly before cpl_ prism_init it will also close424 !! called explicitly before cpl_init it will also close 335 425 !! MPI communication. 336 426 !!---------------------------------------------------------------------- 337 427 ! 338 428 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 429 IF (nstop == 0) THEN 430 CALL oasis_terminate( nerror ) 431 ELSE 432 CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 433 ENDIF 434 ! 435 END SUBROUTINE cpl_finalize 436 437 #if ! defined key_oasis3 438 439 !!---------------------------------------------------------------------- 440 !! No OASIS Library OASIS3 Dummy module... 441 !!---------------------------------------------------------------------- 442 443 SUBROUTINE oasis_init_comp(k1,cd1,k2) 444 CHARACTER(*), INTENT(in ) :: cd1 445 INTEGER , INTENT( out) :: k1,k2 446 k1 = -1 ; k2 = -1 447 WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1 448 END SUBROUTINE oasis_init_comp 449 450 SUBROUTINE oasis_abort(k1,cd1,cd2) 451 INTEGER , INTENT(in ) :: k1 452 CHARACTER(*), INTENT(in ) :: cd1,cd2 453 WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2 454 END SUBROUTINE oasis_abort 455 456 SUBROUTINE oasis_get_localcomm(k1,k2) 457 INTEGER , INTENT( out) :: k1,k2 458 k1 = -1 ; k2 = -1 459 WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...' 460 END SUBROUTINE oasis_get_localcomm 461 462 SUBROUTINE oasis_def_partition(k1,k2,k3) 463 INTEGER , INTENT( out) :: k1,k3 464 INTEGER , INTENT(in ) :: k2(5) 465 k1 = k2(1) ; k3 = k2(5) 466 WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...' 467 END SUBROUTINE oasis_def_partition 468 469 SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 470 CHARACTER(*), INTENT(in ) :: cd1 471 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(2,2),k6 472 INTEGER , INTENT( out) :: k1,k7 473 k1 = -1 ; k7 = -1 474 WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1 475 END SUBROUTINE oasis_def_var 476 477 SUBROUTINE oasis_enddef(k1) 478 INTEGER , INTENT( out) :: k1 479 k1 = -1 480 WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 481 END SUBROUTINE oasis_enddef 482 483 SUBROUTINE oasis_put(k1,k2,p1,k3) 484 REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1 485 INTEGER , INTENT(in ) :: k1,k2 486 INTEGER , INTENT( out) :: k3 487 k3 = -1 488 WRITE(numout,*) 'oasis_put: Error you sould not be there...' 489 END SUBROUTINE oasis_put 490 491 SUBROUTINE oasis_get(k1,k2,p1,k3) 492 REAL(wp), DIMENSION(:,:), INTENT( out) :: p1 493 INTEGER , INTENT(in ) :: k1,k2 494 INTEGER , INTENT( out) :: k3 495 p1(1,1) = -1. ; k3 = -1 496 WRITE(numout,*) 'oasis_get: Error you sould not be there...' 497 END SUBROUTINE oasis_get 498 499 SUBROUTINE oasis_get_freqs(k1,k2,k3,k4) 500 INTEGER , INTENT(in ) :: k1,k2 501 INTEGER, DIMENSION(1), INTENT( out) :: k3 502 INTEGER , INTENT( out) :: k4 503 k3(1) = k1 ; k4 = k2 504 WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...' 505 END SUBROUTINE oasis_get_freqs 506 507 SUBROUTINE oasis_terminate(k1) 508 INTEGER , INTENT( out) :: k1 509 k1 = -1 510 WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 511 END SUBROUTINE oasis_terminate 512 360 513 #endif 361 514
Note: See TracChangeset
for help on using the changeset viewer.