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 3151 – NEMO

Changeset 3151


Ignore:
Timestamp:
2011-11-17T18:16:05+01:00 (12 years ago)
Author:
cbricaud
Message:

new dynamical allocation and add timing calls

Location:
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/FLO
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90

    r3104 r3151  
    1515   USE dom_oce         ! ocean space and time domain 
    1616   USE in_out_manager  ! I/O manager 
     17   USE wrk_nemo_2      ! working array 
    1718 
    1819   IMPLICIT NONE 
     
    5455      INTEGER ::  ierror              ! error value 
    5556 
    56       REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   zgifl , zgjfl , zgkfl    ! index RK  positions 
    57       REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   zufl  , zvfl  , zwfl     ! interpolated velocity at the float position  
    58       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zrkxfl, zrkyfl, zrkzfl   ! RK coefficients 
     57      REAL(wp), POINTER, DIMENSION(:)   ::   zgifl , zgjfl , zgkfl    ! index RK  positions 
     58      REAL(wp), POINTER, DIMENSION(:)   ::   zufl  , zvfl  , zwfl     ! interpolated velocity at the float position  
     59      REAL(wp), POINTER, DIMENSION(:,:) ::   zrkxfl, zrkyfl, zrkzfl   ! RK coefficients 
    5960      !!--------------------------------------------------------------------- 
    60  
    61       ALLOCATE (  zgifl(jpnfl)  ,  zgjfl(jpnfl)  ,  zgkfl(jpnfl)   , & 
    62                    zufl(jpnfl)  ,   zvfl(jpnfl)  ,   zwfl(jpnfl)   , &         
    63                  zrkxfl(jpnfl,4), zrkyfl(jpnfl,4), zrkzfl(jpnfl,4) , STAT=ierror ) 
     61      CALL wrk_alloc( jpnfl,    zgifl , zgjfl , zgkfl  , zufl, zvfl, zwfl) 
     62      CALL wrk_alloc( jpnfl, 4, zrkxfl, zrkyfl, zrkzfl ) 
    6463      ! 
    6564      IF( ierror /= 0 ) THEN 
     
    157156      END DO 
    158157      ! 
    159       DEALLOCATE( zgifl  , zgjfl  , zgkfl  ) 
    160       DEALLOCATE( zufl   , zvfl   , zwfl   ) 
    161       DEALLOCATE( zrkxfl , zrkyfl , zrkzfl ) 
     158      CALL wrk_dealloc( jpnfl,    zgifl , zgjfl , zgkfl  , zufl, zvfl, zwfl) 
     159      CALL wrk_dealloc( jpnfl, 4, zrkxfl, zrkyfl, zrkzfl ) 
    162160      ! 
    163161   END SUBROUTINE flo_4rk 
     
    182180      INTEGER  ::   jfl, jind1, jind2, jind3   ! dummy loop indices 
    183181      REAL(wp) ::   zsumu, zsumv, zsumw        ! local scalar 
    184       INTEGER , DIMENSION(jpnfl)   ::   iilu, ijlu, iklu   ! nearest neighbour INDEX-u 
    185       INTEGER , DIMENSION(jpnfl)   ::   iilv, ijlv, iklv   ! nearest neighbour INDEX-v 
    186       INTEGER , DIMENSION(jpnfl)   ::   iilw, ijlw, iklw   ! nearest neighbour INDEX-w 
    187       INTEGER , DIMENSION(jpnfl,4) ::   iidu, ijdu, ikdu   ! 64 nearest neighbour INDEX-u 
    188       INTEGER , DIMENSION(jpnfl,4) ::   iidv, ijdv, ikdv   ! 64 nearest neighbour INDEX-v 
    189       INTEGER , DIMENSION(jpnfl,4) ::   iidw, ijdw, ikdw   ! 64 nearest neighbour INDEX-w 
    190       REAL(wp) , DIMENSION(jpnfl,4,4,4) ::   ztufl , ztvfl , ztwfl   ! velocity at choosen time step 
    191       REAL(wp) , DIMENSION(jpnfl,4)     ::   zlagxu, zlagyu, zlagzu   ! Lagrange  coefficients 
    192       REAL(wp) , DIMENSION(jpnfl,4)     ::   zlagxv, zlagyv, zlagzv   !    -           - 
    193       REAL(wp) , DIMENSION(jpnfl,4)     ::   zlagxw, zlagyw, zlagzw   !    -           - 
     182      INTEGER  , POINTER, DIMENSION(:)       ::   iilu, ijlu, iklu   ! nearest neighbour INDEX-u 
     183      INTEGER  , POINTER, DIMENSION(:)       ::   iilv, ijlv, iklv   ! nearest neighbour INDEX-v 
     184      INTEGER  , POINTER, DIMENSION(:)       ::   iilw, ijlw, iklw   ! nearest neighbour INDEX-w 
     185      INTEGER  , POINTER, DIMENSION(:,:)    ::   iidu, ijdu, ikdu   ! 64 nearest neighbour INDEX-u 
     186      INTEGER  , POINTER, DIMENSION(:,:)    ::   iidv, ijdv, ikdv   ! 64 nearest neighbour INDEX-v 
     187      INTEGER  , POINTER, DIMENSION(:,:)    ::   iidw, ijdw, ikdw   ! 64 nearest neighbour INDEX-w 
     188      REAL(wp) , POINTER, DIMENSION(:,:)     ::   zlagxu, zlagyu, zlagzu   ! Lagrange  coefficients 
     189      REAL(wp) , POINTER, DIMENSION(:,:)     ::   zlagxv, zlagyv, zlagzv   !    -           - 
     190      REAL(wp) , POINTER, DIMENSION(:,:)     ::   zlagxw, zlagyw, zlagzw   !    -           - 
     191      REAL(wp) , POINTER, DIMENSION(:,:,:,:) ::   ztufl , ztvfl , ztwfl   ! velocity at choosen time step 
    194192      !!--------------------------------------------------------------------- 
    195        
     193      CALL wrk_alloc( jpnfl,    iilu, ijlu, iklu, iilv, ijlv, iklv, iilw, ijlw, iklw ) 
     194      CALL wrk_alloc( jpnfl, 4, iidu, ijdu, ikdu, iidv, ijdv, ikdv, iidw, ijdw, ikdw ) 
     195      CALL wrk_alloc( jpnfl, 4, zlagxu, zlagyu, zlagzu, zlagxv, zlagyv, zlagzv, zlagxw, zlagyw, zlagzw ) 
     196      CALL wrk_alloc( jpnfl, 4, 4, 4, ztufl , ztvfl , ztwfl ) 
     197  
    196198      ! Interpolation of U velocity 
    197199 
     
    451453      END DO 
    452454      !    
     455      CALL wrk_dealloc( jpnfl,    iilu, ijlu, iklu, iilv, ijlv, iklv, iilw, ijlw, iklw ) 
     456      CALL wrk_dealloc( jpnfl, 4, iidu, ijdu, ikdu, iidv, ijdv, ikdv, iidw, ijdw, ikdw ) 
     457      CALL wrk_dealloc( jpnfl, 4, zlagxu, zlagyu, zlagzu, zlagxv, zlagyv, zlagzv, zlagxw, zlagyw, zlagzw ) 
     458      CALL wrk_dealloc( jpnfl, 4, 4, 4, ztufl , ztvfl , ztwfl ) 
     459      !    
    453460   END SUBROUTINE flo_interp 
    454461 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90

    r3104 r3151  
    2323   USE floblk          ! Trajectories, Blanke scheme      (flo_blk routine) 
    2424   USE in_out_manager  ! I/O manager 
     25   USE timing          ! preformance summary 
    2526 
    2627   IMPLICIT NONE 
     
    5152      !!---------------------------------------------------------------------- 
    5253      ! 
     54      IF( nn_timing == 1 )   CALL timing_start('flo_stp') 
     55      ! 
    5356      IF( ln_flork4 ) THEN   ;   CALL flo_4rk( kt )        ! Trajectories using a 4th order Runge Kutta scheme 
    5457      ELSE                   ;   CALL flo_blk( kt )        ! Trajectories using Blanke' algorithme 
     
    6265      ! 
    6366      wb(:,:,:) = wn(:,:,:)         ! Save the old vertical velocity field 
     67      ! 
     68      IF( nn_timing == 1 )   CALL timing_stop('flo_stp') 
    6469      ! 
    6570   END SUBROUTINE flo_stp 
     
    7681      NAMELIST/namflo/ jpnfl, jpnnewflo, ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4, ln_ariane, ln_flo_ascii 
    7782      !!--------------------------------------------------------------------- 
     83      ! 
     84      IF( nn_timing == 1 )   CALL timing_start('flo_init') 
    7885      ! 
    7986      IF(lwp) WRITE(numout,*) 
     
    122129      wb(:,:,:) = wn(:,:,:)         ! set wb for computation of floats trajectories at the first time step 
    123130      ! 
     131      IF( nn_timing == 1 )   CALL timing_stop('flo_init') 
     132      ! 
    124133   END SUBROUTINE flo_init 
    125134 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90

    r2715 r3151  
    1717   USE in_out_manager  ! I/O manager 
    1818   USE lib_mpp         ! distribued memory computing library 
     19   USE wrk_nemo_2      ! working array 
    1920 
    2021   IMPLICIT NONE 
     
    4748      INTEGER :: jfl              ! dummy loop arguments 
    4849      INTEGER :: ind, ifin, iloop 
    49       INTEGER , DIMENSION ( jpnfl )  ::   & 
     50      REAL(wp)   ::       & 
     51         zuinfl,zvinfl,zwinfl,      &     ! transport across the input face 
     52         zuoutfl,zvoutfl,zwoutfl,   &     ! transport across the ouput face 
     53         zvol,                      &     ! volume of the mesh 
     54         zsurfz,                    &     ! surface of the face of the mesh  
     55         zind 
     56 
     57      REAL(wp), DIMENSION ( 2 )  ::   zsurfx, zsurfy   ! surface of the face of the mesh 
     58 
     59      INTEGER , POINTER, DIMENSION ( : )  ::   & 
    5060         iil, ijl, ikl,             &     ! index of nearest mesh 
    5161         iiloc , ijloc,             & 
    5262         iiinfl, ijinfl, ikinfl,    &     ! index of input mesh of the float. 
    5363         iioutfl, ijoutfl, ikoutfl        ! index of output mesh of the float. 
    54       REAL(wp) , DIMENSION ( jpnfl )  ::    & 
     64      REAL(wp) , POINTER, DIMENSION ( : )  ::    & 
    5565         zgifl, zgjfl, zgkfl,       &     ! position of floats, index on  
    5666                                          ! velocity mesh. 
     
    6474         zufl, zvfl, zwfl,          &     ! interpolated vel. at float position 
    6575         zudfl, zvdfl, zwdfl,       &     ! velocity diff input/output of mesh 
    66          zgidfl, zgjdfl, zgkdfl           ! direction index of float  
    67       REAL(wp)   ::       & 
    68          zuinfl,zvinfl,zwinfl,      &     ! transport across the input face 
    69          zuoutfl,zvoutfl,zwoutfl,   &     ! transport across the ouput face 
    70          zvol,                      &     ! volume of the mesh 
    71          zsurfz,                    &     ! surface of the face of the mesh  
    72          zind 
    73       REAL(wp), DIMENSION ( 2 )  ::   zsurfx, zsurfy   ! surface of the face of the mesh 
     76         zgidfl, zgjdfl, zgkdfl           ! direction index of float 
    7477      !!--------------------------------------------------------------------- 
    75        
     78      CALL wrk_alloc( jpnfl , iil   , ijl   , ikl   , iiloc  ,  ijloc           ) 
     79      CALL wrk_alloc( jpnfl , iiinfl, ijinfl, ikinfl, iioutfl, ijoutfl, ikoutfl ) 
     80      CALL wrk_alloc( jpnfl , zgifl , zgjfl , zgkfl , ztxfl  , ztyfl  , ztzfl   , zttfl , zagefl, zagenewfl)  
     81      CALL wrk_alloc( jpnfl , zufl  , zvfl  , zwfl  , zudfl  , zvdfl  , zwdfl   , zgidfl, zgjdfl, zgkdfl   ) 
     82 
    7683      IF( kt == nit000 ) THEN 
    7784         IF(lwp) WRITE(numout,*) 
     
    406413      ENDIF 
    407414      ! 
     415      CALL wrk_dealloc( jpnfl , iil   , ijl   , ikl   , iiloc  ,  ijloc           ) 
     416      CALL wrk_dealloc( jpnfl , iiinfl, ijinfl, ikinfl, iioutfl, ijoutfl, ikoutfl ) 
     417      CALL wrk_dealloc( jpnfl , zgifl , zgjfl , zgkfl , ztxfl  , ztyfl  , ztzfl   , zttfl , zagefl, zagenewfl)  
     418      CALL wrk_dealloc( jpnfl , zufl  , zvfl  , zwfl  , zudfl  , zvdfl  , zwdfl   , zgidfl, zgjdfl, zgkdfl   ) 
     419      ! 
    408420   END SUBROUTINE flo_blk 
    409421 
Note: See TracChangeset for help on using the changeset viewer.