New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3281 for branches/2011/dev_NEMO_MERGE_2011/NEMOGCM – NEMO

Ignore:
Timestamp:
2012-01-27T14:06:42+01:00 (12 years ago)
Author:
rblod
Message:

Fix diaptr_init see ticket #912

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r3255 r3281  
    472472         WRITE(numout,*) '      Frequency of outputs                               nn_fwri    = ', nn_fwri 
    473473      ENDIF 
    474  
    475       IF( ln_subbas ) THEN   ;   nptr = 5       ! Global, Atlantic, Pacific, Indian, Indo-Pacific 
    476       ELSE                   ;   nptr = 1       ! Global only 
    477       ENDIF 
    478  
    479       !                                      ! allocate dia_ptr arrays 
    480       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 PetaWatt 
    483  
    484       IF( .NOT. ln_diaptr ) THEN       ! diaptr not used 
    485         RETURN 
    486       ENDIF 
    487474       
    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   
    502476       
    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 
    506500       
    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 
    515513 
    516514      ! Initialise arrays to zero because diatpr is called before they are first calculated 
     
    519517 
    520518#if defined key_mpp_mpi  
    521       iglo (1) = jpjglo                   ! MPP case using MPI  ('key_mpp_mpi') 
    522       iloc (1) = nlcj 
    523       iabsf(1) = njmppt(narea) 
    524       iabsl(:) = iabsf(:) + iloc(:) - 1 
    525       ihals(1) = nldj - 1 
    526       ihale(1) = nlcj - nlej 
    527       idid (1) = 2 
    528       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 ) 
    529527#else 
    530       nidom_ptr = FLIO_DOM_NONE 
    531 #endif 
     528         nidom_ptr = FLIO_DOM_NONE 
     529#endif 
     530      ENDIF  
    532531      !  
    533532      IF( nn_timing == 1 )   CALL timing_stop('dia_ptr_init') 
Note: See TracChangeset for help on using the changeset viewer.