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 11738 for branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90 – NEMO

Ignore:
Timestamp:
2019-10-21T09:34:11+02:00 (5 years ago)
Author:
marc
Message:

The Dr Hook changes from my perl code.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    r10047 r11738  
    4848  USE wrk_nemo        ! working arrays 
    4949 
     50  USE yomhook, ONLY: lhook, dr_hook 
     51  USE parkind1, ONLY: jprb, jpim 
     52 
    5053  IMPLICIT NONE 
    5154  PRIVATE 
    … …  
    121124     !!----------------------------------------------------------------------  
    122125     INTEGER :: ierr(2)  
     126     INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0 
     127     INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1 
     128     REAL(KIND=jprb)               :: zhook_handle 
     129 
     130     CHARACTER(LEN=*), PARAMETER :: RoutineName='DIADCT_ALLOC' 
     131 
     132     IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle) 
     133 
    123134     !!----------------------------------------------------------------------  
    124135 
    … …  
    129140     IF( diadct_alloc /= 0 )   CALL ctl_warn('diadct_alloc: failed to allocate arrays')  
    130141  
     142     IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle) 
    131143  END FUNCTION diadct_alloc  
    132144 
    … …  
    141153     NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug 
    142154     INTEGER  ::   ios                 ! Local integer output status for namelist read 
     155     INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0 
     156     INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1 
     157     REAL(KIND=jprb)               :: zhook_handle 
     158 
     159     CHARACTER(LEN=*), PARAMETER :: RoutineName='DIA_DCT_INIT' 
     160 
     161     IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle) 
     162 
    143163 
    144164     IF( nn_timing == 1 )   CALL timing_start('dia_dct_init') 
    … …  
    188208     IF( nn_timing == 1 )   CALL timing_stop('dia_dct_init') 
    189209     ! 
     210     IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle) 
    190211  END SUBROUTINE dia_dct_init 
    191212  
    … …  
    220241     REAL(wp), POINTER, DIMENSION(:)    :: zwork !   "   
    221242     REAL(wp), POINTER, DIMENSION(:,:,:):: zsum  !   " 
     243     INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0 
     244     INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1 
     245     REAL(KIND=jprb)               :: zhook_handle 
     246 
     247     CHARACTER(LEN=*), PARAMETER :: RoutineName='DIA_DCT' 
     248 
     249     IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle) 
     250 
    222251 
    223252     !!---------------------------------------------------------------------     
    … …  
    304333     IF( nn_timing == 1 )   CALL timing_stop('dia_dct') 
    305334     ! 
     335     IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle) 
    306336  END SUBROUTINE dia_dct 
    307337 
    … …  
    331361     LOGICAL :: llbon                                       ,&!local logical 
    332362                lldebug                                       !debug the section 
     363                INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0 
     364                INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1 
     365                REAL(KIND=jprb)               :: zhook_handle 
     366 
     367                CHARACTER(LEN=*), PARAMETER :: RoutineName='READSEC' 
     368 
     369                IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle) 
     370 
    333371     !!------------------------------------------------------------------------------------- 
    334372     CALL wrk_alloc( nb_point_max, directemp ) 
    … …  
    506544     CALL wrk_dealloc( nb_point_max, directemp ) 
    507545     ! 
     546                IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle) 
    508547  END SUBROUTINE readsec 
    509548 
    … …  
    526565                itest         ,& !indice value of the side of the domain  
    527566                                 !where points could be redundant 
     567                                 INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0 
     568                                 INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1 
     569                                 REAL(KIND=jprb)               :: zhook_handle 
     570 
     571                                 CHARACTER(LEN=*), PARAMETER :: RoutineName='REMOVEPOINTS' 
     572 
     573                                 IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle) 
     574 
    528575                isgn          ,& ! isgn= 1 : scan listpoint from start to end 
    529576                                 ! isgn=-1 : scan listpoint from end to start  
    … …  
    586633     CALL wrk_dealloc(    nb_point_max, idirec ) 
    587634     CALL wrk_dealloc( 2, nb_point_max, icoord ) 
     635                                 IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle) 
    588636  END SUBROUTINE removepoints 
    589637 
    … …  
    622670 
    623671     TYPE(POINT_SECTION) :: k 
     672     INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0 
     673     INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1 
     674     REAL(KIND=jprb)               :: zhook_handle 
     675 
     676     CHARACTER(LEN=*), PARAMETER :: RoutineName='TRANSPORT' 
     677 
     678     IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle) 
     679 
    624680     !!-------------------------------------------------------- 
    625681 
    … …  
    807863     ENDIF !end of sec%nb_point =0 case 
    808864     ! 
     865     IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle) 
    809866  END SUBROUTINE transport 
    810867   
    … …  
    835892     INTEGER  :: jk,jseg,jclass                        ! dummy variables for looping on level/segment/classes   
    836893     REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point  
     894     INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0 
     895     INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1 
     896     REAL(KIND=jprb)               :: zhook_handle 
     897 
     898     CHARACTER(LEN=*), PARAMETER :: RoutineName='DIA_DCT_SUM' 
     899 
     900     IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle) 
     901 
    837902     !!-------------------------------------------------------------  
    838903  
    … …  
    9991064     ENDIF !end of sec%nb_point =0 case  
    10001065  
     1066     IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle) 
    10011067  END SUBROUTINE dia_dct_sum  
    10021068   
    … …  
    10301096     ! 
    10311097     REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace  
     1098     INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0 
     1099     INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1 
     1100     REAL(KIND=jprb)               :: zhook_handle 
     1101 
     1102     CHARACTER(LEN=*), PARAMETER :: RoutineName='DIA_DCT_WRI' 
     1103 
     1104     IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle) 
     1105 
    10321106     !!-------------------------------------------------------------  
    10331107     CALL wrk_alloc(nb_type_class , zsumclasses )   
    … …  
    11441218 
    11451219     CALL wrk_dealloc(nb_type_class , zsumclasses )   
     1220     IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle) 
    11461221  END SUBROUTINE dia_dct_wri 
    11471222 
    … …  
    12181293  REAL(wp):: zdep1,zdep2                                       ! differences of depth 
    12191294  REAL(wp):: zmsk                                              ! mask value 
     1295  INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0 
     1296  INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1 
     1297  REAL(KIND=jprb)               :: zhook_handle 
     1298 
     1299  CHARACTER(LEN=*), PARAMETER :: RoutineName='INTERP' 
     1300 
     1301  IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle) 
     1302 
    12201303  !!---------------------------------------------------------------------- 
    12211304 
    … …  
    12901373 
    12911374 
     1375  IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle) 
    12921376  END FUNCTION interp 
    12931377 
    … …  
    13021386 
    13031387   SUBROUTINE dia_dct_init          ! Dummy routine 
     1388   USE yomhook, ONLY: lhook, dr_hook 
     1389   USE parkind1, ONLY: jprb, jpim 
     1390 
    13041391   IMPLICIT NONE 
     1392   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0 
     1393   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1 
     1394   REAL(KIND=jprb)               :: zhook_handle 
     1395 
     1396   CHARACTER(LEN=*), PARAMETER :: RoutineName='DIA_DCT_INIT' 
     1397 
     1398   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle) 
     1399 
    13051400      WRITE(*,*) 'dia_dct_init: You should not have seen this print! error?' 
     1401   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle) 
    13061402   END SUBROUTINE dia_dct_init 
    13071403 
    13081404   SUBROUTINE dia_dct( kt )         ! Dummy routine 
     1405   USE yomhook, ONLY: lhook, dr_hook 
     1406   USE parkind1, ONLY: jprb, jpim 
     1407 
    13091408   IMPLICIT NONE 
    13101409      INTEGER, INTENT( in ) :: kt   ! ocean time-step index 
     1410      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0 
     1411      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1 
     1412      REAL(KIND=jprb)               :: zhook_handle 
     1413 
     1414      CHARACTER(LEN=*), PARAMETER :: RoutineName='DIA_DCT' 
     1415 
     1416      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle) 
     1417 
    13111418      WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt 
     1419      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle) 
    13121420   END SUBROUTINE dia_dct 
    13131421#endif 
Note: See TracChangeset for help on using the changeset viewer.