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

Changeset 7545


Ignore:
Timestamp:
2017-01-11T12:27:34+01:00 (7 years ago)
Author:
frrh
Message:

Apply Maff's changes with the exception of
NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90
which will clash with changes made to the source code since
the optimisation work started.

Location:
branches/UKMO/MEDUSA_optim_MG_MS_RH/NEMOGCM/NEMO
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/MEDUSA_optim_MG_MS_RH/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r5733 r7545  
    9393      !                                                         ! =-1 not cyclic 
    9494      LOGICAL                                 ::   cyclic       ! east-west cyclic or not 
    95       INTEGER,  DIMENSION(:,:,:), POINTER    ::   data_jpi     ! array of source integers 
    96       INTEGER,  DIMENSION(:,:,:), POINTER    ::   data_jpj     ! array of source integers 
    97       REAL(wp), DIMENSION(:,:,:), POINTER    ::   data_wgt     ! array of weights on model grid 
    98       REAL(wp), DIMENSION(:,:,:), POINTER    ::   fly_dta      ! array of values on input grid 
    99       REAL(wp), DIMENSION(:,:,:), POINTER    ::   col          ! temporary array for reading in columns 
     95      INTEGER,  DIMENSION(:,:,:), ALLOCATABLE ::   data_jpi     ! array of source integers 
     96      INTEGER,  DIMENSION(:,:,:), ALLOCATABLE ::   data_jpj     ! array of source integers 
     97      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   data_wgt     ! array of weights on model grid 
     98      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   fly_dta      ! array of values on input grid 
     99      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   col          ! temporary array for reading in columns 
    100100   END TYPE WGT 
    101101 
    … …  
    688688      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read  ! work space for global data 
    689689      !!--------------------------------------------------------------------- 
    690              
     690 
    691691      ipi = SIZE( dta, 1 ) 
    692692      ipj = 1 
    … …  
    745745      INTEGER                           ::   ill          ! character length 
    746746      INTEGER                           ::   iv           ! indice of V component 
    747       REAL(wp), POINTER, DIMENSION(:,:) ::   utmp, vtmp   ! temporary arrays for vector rotation 
     747      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   utmp, vtmp   ! temporary arrays for vector rotation 
    748748      CHARACTER (LEN=100)               ::   clcomp       ! dummy weight name 
    749749      !!--------------------------------------------------------------------- 
    750750 
    751       CALL wrk_alloc( jpi,jpj, utmp, vtmp ) 
     751      ALLOCATE( utmp (1:jpi, 1:jpj) ) 
     752      ALLOCATE( vtmp (1:jpi, 1:jpj) ) 
    752753 
    753754      !! (sga: following code should be modified so that pairs arent searched for each time 
    … …  
    786787       END DO 
    787788      ! 
    788       CALL wrk_dealloc( jpi,jpj, utmp, vtmp ) 
     789      DEALLOCATE (utmp, vtmp) 
    789790      ! 
    790791   END SUBROUTINE fld_rot 
    … …  
    935936         END DO 
    936937      ENDIF 
    937        
     938 
    938939   END SUBROUTINE fld_fill 
    939940 
    … …  
    10051006            WRITE(numout,*) '       not cyclical' 
    10061007         ENDIF 
    1007          IF( ASSOCIATED(ref_wgts(kw)%data_wgt) )  WRITE(numout,*) '       allocated' 
     1008         IF( ALLOCATED(ref_wgts(kw)%data_wgt) )  WRITE(numout,*) '       allocated' 
    10081009      END DO 
    10091010      ! 
    … …  
    10261027      CHARACTER (len=5)                 ::   aname 
    10271028      INTEGER , DIMENSION(:), ALLOCATABLE ::   ddims 
    1028       INTEGER , POINTER, DIMENSION(:,:) ::   data_src 
    1029       REAL(wp), POINTER, DIMENSION(:,:) ::   data_tmp 
     1029      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   data_src 
     1030      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   data_tmp 
    10301031      LOGICAL                           ::   cyclical 
    10311032      INTEGER                           ::   zwrap      ! local integer 
    10321033      !!---------------------------------------------------------------------- 
    10331034      ! 
    1034       CALL wrk_alloc( jpi,jpj, data_src )   ! integer 
    1035       CALL wrk_alloc( jpi,jpj, data_tmp ) 
     1035      ALLOCATE(data_src(1:jpi, 1:jpj)) 
     1036      ALLOCATE(data_tmp(1:jpi, 1:jpj)) 
     1037 
    10361038      ! 
    10371039      IF( nxt_wgt > tot_wgts ) THEN 
    … …  
    11521154      DEALLOCATE (ddims ) 
    11531155 
    1154       CALL wrk_dealloc( jpi,jpj, data_src )   ! integer 
    1155       CALL wrk_dealloc( jpi,jpj, data_tmp ) 
     1156      DEALLOCATE( data_src )   ! integer 
     1157      DEALLOCATE( data_tmp ) 
    11561158      ! 
    11571159   END SUBROUTINE fld_weight 
    … …  
    12941296      INTEGER                                   ::   jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm   ! temporary indices 
    12951297      INTEGER                                   ::   itmpi,itmpj,itmpz                     ! lengths 
    1296        
     1298 
    12971299      !!---------------------------------------------------------------------- 
    12981300      ! 

  • branches/UKMO/MEDUSA_optim_MG_MS_RH/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90

    r5735 r7545  
    9393      REAL(wp) ::   zgcad        ! temporary scalars 
    9494      REAL(wp), DIMENSION(2) ::   zsum 
    95       REAL(wp), POINTER, DIMENSION(:,:) ::   zgcr 
     95      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zgcr 
    9696      !!---------------------------------------------------------------------- 
    9797      ! 
    9898      IF( nn_timing == 1 )  CALL timing_start('sol_pcg') 
    9999      ! 
    100       CALL wrk_alloc( jpi, jpj, zgcr ) 
     100      ALLOCATE( zgcr(jpi,jpj) ) 
    101101      ! 
    102102      ! Initialization of the algorithm with standard PCG 
    … …  
    210210      CALL lbc_lnk( gcx, c_solver_pt, 1. )      ! Output in gcx with lateral b.c. applied 
    211211      !  
    212       CALL wrk_dealloc( jpi, jpj, zgcr ) 
     212      DEALLOCATE ( zgcr ) 
    213213      ! 
    214214      IF( nn_timing == 1 )  CALL timing_stop('sol_pcg') 

  • branches/UKMO/MEDUSA_optim_MG_MS_RH/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r5733 r7545  
    7878      ! 
    7979      INTEGER ::   jk   ! dummy loop index 
    80       REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 
     80      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zun, zvn, zwn 
     81 
    8182      !!---------------------------------------------------------------------- 
    8283      ! 
    8384      IF( nn_timing == 1 )  CALL timing_start('tra_adv') 
    8485      ! 
    85       CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 
     86 
     87      ALLOCATE( zun(1:jpi, 1:jpj, 1:jpk) ) 
     88      ALLOCATE( zvn(1:jpi, 1:jpj, 1:jpk) ) 
     89      ALLOCATE( zwn(1:jpi, 1:jpj, 1:jpk) ) 
     90 
    8691      !                                          ! set time step 
    8792      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    … …  
    108113      zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    109114      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
     115 
    110116      ! 
    111117      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   & 
    … …  
    155161         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    156162      ! 
     163      DEALLOCATE ( zun, zvn, zwn ) 
    157164      IF( nn_timing == 1 )  CALL timing_stop( 'tra_adv' ) 
    158165      ! 
    159       CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn ) 
    160166      !                                           
    161167   END SUBROUTINE tra_adv 

  • branches/UKMO/MEDUSA_optim_MG_MS_RH/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r5735 r7545  
    8282      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      - 
    8383      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      - 
    84       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace 
    85       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      -  
     84      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace 
     85      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      -  
     86 
    8687      !!---------------------------------------------------------------------- 
    8788      ! 
    8889      IF( nn_timing == 1 )  CALL timing_start('tra_adv_muscl') 
    8990      ! 
    90       CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 
     91      ALLOCATE( zslpx(1:jpi, 1:jpj, 1:jpk) ) 
     92      ALLOCATE( zslpy(1:jpi, 1:jpj, 1:jpk) ) 
     93      ALLOCATE( zwx  (1:jpi, 1:jpj, 1:jpk) ) 
     94      ALLOCATE( zwy  (1:jpi, 1:jpj, 1:jpk) ) 
    9195      ! 
    9296      IF( kt == kit000 )  THEN 
    … …  
    291295      END DO 
    292296      ! 
    293       CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 
     297      DEALLOCATE( zslpx ) 
     298      DEALLOCATE( zslpy ) 
     299      DEALLOCATE( zwx   ) 
     300      DEALLOCATE( zwy   ) 
    294301      ! 
    295302      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_muscl') 

  • branches/UKMO/MEDUSA_optim_MG_MS_RH/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r5733 r7545  
    107107      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    108108      ! 
    109       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
     109      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    110110      !!---------------------------------------------------------------------- 
    111111      ! 
    … …  
    113113      ! 
    114114      IF( l_trdtra )   THEN                         !* Save ta and sa trends 
    115          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     115         ALLOCATE( ztrdt (1:jpi, 1:jpj, 1:jpk)) 
     116         ALLOCATE( ztrds (1:jpi, 1:jpj, 1:jpk)) 
    116117         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    117118         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    151152         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    152153         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    153          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     154         DEALLOCATE( ztrdt, ztrds ) 
    154155      ENDIF 
    155156      ! 
    … …  
    187188      INTEGER  ::   ik           ! local integers 
    188189      REAL(wp) ::   zbtr         ! local scalars 
    189       REAL(wp), POINTER, DIMENSION(:,:) :: zptb 
     190      REAL(wp), ALLOCATABLE , DIMENSION(:,:) :: zptb 
    190191      !!---------------------------------------------------------------------- 
    191192      ! 
    192193      IF( nn_timing == 1 )  CALL timing_start('tra_bbl_dif') 
    193194      ! 
    194       CALL wrk_alloc( jpi, jpj, zptb ) 
     195      ALLOCATE(zptb(1:jpi, 1:jpj)) 
    195196      ! 
    196197      DO jn = 1, kjpt                                     ! tracer loop 
    … …  
    217218      END DO                                                ! end tracer 
    218219      !                                                     ! =========== 
    219       CALL wrk_dealloc( jpi, jpj, zptb ) 
     220      DEALLOCATE( zptb ) 
    220221      ! 
    221222      IF( nn_timing == 1 )  CALL timing_stop('tra_bbl_dif') 

  • branches/UKMO/MEDUSA_optim_MG_MS_RH/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r5733 r7545  
    108108      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    109109      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      - 
    110       REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d 
    111       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdkt, zdk1t, zdit, zdjt, ztfw  
     110      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) ::  z2d 
     111      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  zdkt, zdk1t, zdit, zdjt, ztfw  
    112112      !!---------------------------------------------------------------------- 
    113113      ! 
    114114      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso') 
    115115      ! 
    116       CALL wrk_alloc( jpi, jpj,      z2d )  
    117       CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t )  
     116      ALLOCATE( z2d   (1:jpi, 1:jpj) ) 
     117      ALLOCATE( zdit  (1:jpi, 1:jpj, 1:jpk) ) 
     118      ALLOCATE( zdjt  (1:jpi, 1:jpj, 1:jpk) ) 
     119      ALLOCATE( ztfw  (1:jpi, 1:jpj, 1:jpk) ) 
     120      ALLOCATE( zdkt  (1:jpi, 1:jpj, 1:jpk) ) 
     121      ALLOCATE( zdk1t (1:jpi, 1:jpj, 1:jpk) ) 
    118122      ! 
    119123 
    … …  
    322326      END DO 
    323327      ! 
    324       CALL wrk_dealloc( jpi, jpj, z2d )  
    325       CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t )  
     328      DEALLOCATE( z2d    ) 
     329      DEALLOCATE( zdit   ) 
     330      DEALLOCATE( zdjt   ) 
     331      DEALLOCATE( ztfw   ) 
     332      DEALLOCATE( zdkt   ) 
     333      DEALLOCATE( zdk1t  ) 
     334      ! 
     335 
    326336      ! 
    327337      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso') 

  • branches/UKMO/MEDUSA_optim_MG_MS_RH/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90

    r5729 r7545  
    5353      INTEGER, INTENT( in ) ::   kt   ! ocean time-step  
    5454      CHARACTER (len=22) :: charout 
    55       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
     55      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrtrd 
    5656      !!---------------------------------------------------------------------- 
    5757      ! 
    … …  
    6464 
    6565      IF( l_trdtrc )  THEN 
    66          CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends 
     66         ALLOCATE( ztrtrd (1:jpi, 1:jpj, 1:jpk, 1:jptra) ) 
    6767         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    6868      ENDIF 
    … …  
    9595           CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 
    9696        END DO 
    97         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends 
     97        DEALLOCATE( ztrtrd ) ! temporary save of trends 
    9898      ENDIF 
    9999      ! 

  • branches/UKMO/MEDUSA_optim_MG_MS_RH/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r5729 r7545  
    5858      INTEGER            :: jn 
    5959      CHARACTER (len=22) :: charout 
    60       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
     60      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrtrd 
    6161      !!---------------------------------------------------------------------- 
    6262      ! 
    … …  
    6868 
    6969      IF( l_trdtrc )  THEN 
    70          CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 
     70         ALLOCATE( ztrtrd(1:jpi, 1:jpj, 1:jpk, 1:jptra)) 
    7171         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    7272      ENDIF 
    … …  
    107107           CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
    108108        END DO 
    109         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
     109        DEALLOCATE( ztrtrd ) 
    110110      ENDIF 
    111111      !                                          ! print mean trends (used for debugging) 
Note: See TracChangeset for help on using the changeset viewer.