Changeset 3281
- Timestamp:
- 2012-01-27T14:06:42+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r3255 r3281 472 472 WRITE(numout,*) ' Frequency of outputs nn_fwri = ', nn_fwri 473 473 ENDIF 474 475 IF( ln_subbas ) THEN ; nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific476 ELSE ; nptr = 1 ! Global only477 ENDIF478 479 ! ! allocate dia_ptr arrays480 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate arrays' )481 482 rc_pwatt = rc_pwatt * rau0 * rcp ! conversion from K.s-1 to PetaWatt483 484 IF( .NOT. ln_diaptr ) THEN ! diaptr not used485 RETURN486 ENDIF487 474 488 IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum 489 490 IF( ln_subbas ) THEN ! load sub-basin mask 491 CALL iom_open( 'subbasins', inum ) 492 CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 493 CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 494 CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) ) ! Indian basin 495 CALL iom_close( inum ) 496 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 497 WHERE( gphit(:,:) < -30._wp) ; btm30(:,:) = 0._wp ! mask out Southern Ocean 498 ELSE WHERE ; btm30(:,:) = tmask(:,:,1) 499 END WHERE 500 ENDIF 501 btmsk(:,:,1) = tmask_i(:,:) ! global ocean 475 IF( ln_diaptr) THEN 502 476 503 DO jn = 1, nptr 504 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 505 END DO 477 IF( ln_subbas ) THEN ; nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific 478 ELSE ; nptr = 1 ! Global only 479 ENDIF 480 481 ! ! allocate dia_ptr arrays 482 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 483 484 rc_pwatt = rc_pwatt * rau0 * rcp ! conversion from K.s-1 to PetaWatt 485 486 IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum 487 488 IF( ln_subbas ) THEN ! load sub-basin mask 489 CALL iom_open( 'subbasins', inum ) 490 CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 491 CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 492 CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) ) ! Indian basin 493 CALL iom_close( inum ) 494 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 495 WHERE( gphit(:,:) < -30._wp) ; btm30(:,:) = 0._wp ! mask out Southern Ocean 496 ELSE WHERE ; btm30(:,:) = tmask(:,:,1) 497 END WHERE 498 ENDIF 499 btmsk(:,:,1) = tmask_i(:,:) ! global ocean 506 500 507 IF( lk_vvl ) CALL ctl_stop( 'diaptr: error in vvl case as constant i-mean surface is used' ) 508 509 ! ! i-sum of e1v*e3v surface and its inverse 510 DO jn = 1, nptr 511 sjk(:,:,jn) = ptr_tjk( tmask(:,:,:), btmsk(:,:,jn) ) 512 r1_sjk(:,:,jn) = 0._wp 513 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 514 END DO 501 DO jn = 1, nptr 502 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 503 END DO 504 505 IF( lk_vvl ) CALL ctl_stop( 'diaptr: error in vvl case as constant i-mean surface is used' ) 506 507 ! ! i-sum of e1v*e3v surface and its inverse 508 DO jn = 1, nptr 509 sjk(:,:,jn) = ptr_tjk( tmask(:,:,:), btmsk(:,:,jn) ) 510 r1_sjk(:,:,jn) = 0._wp 511 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 512 END DO 515 513 516 514 ! Initialise arrays to zero because diatpr is called before they are first calculated … … 519 517 520 518 #if defined key_mpp_mpi 521 iglo (1) = jpjglo ! MPP case using MPI ('key_mpp_mpi')522 iloc (1) = nlcj523 iabsf(1) = njmppt(narea)524 iabsl(:) = iabsf(:) + iloc(:) - 1525 ihals(1) = nldj - 1526 ihale(1) = nlcj - nlej527 idid (1) = 2528 CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr )519 iglo (1) = jpjglo ! MPP case using MPI ('key_mpp_mpi') 520 iloc (1) = nlcj 521 iabsf(1) = njmppt(narea) 522 iabsl(:) = iabsf(:) + iloc(:) - 1 523 ihals(1) = nldj - 1 524 ihale(1) = nlcj - nlej 525 idid (1) = 2 526 CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr ) 529 527 #else 530 nidom_ptr = FLIO_DOM_NONE 531 #endif 528 nidom_ptr = FLIO_DOM_NONE 529 #endif 530 ENDIF 532 531 ! 533 532 IF( nn_timing == 1 ) CALL timing_stop('dia_ptr_init')
Note: See TracChangeset
for help on using the changeset viewer.