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 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/IOM – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/IOM
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r2528 r2715  
    1212   !!---------------------------------------------------------------------- 
    1313 
    14    !!---------------------------------------------------------------------- 
    15    !!   ctl_stop   : update momentum and tracer Kz from a tke scheme 
    16    !!   ctl_warn   : initialization, namelist read, and parameters control 
    17    !!   getunit    : give the index of an unused logical unit 
    1814   !!---------------------------------------------------------------------- 
    1915   USE par_oce       ! ocean parameter 
    … …  
    134130   !! $Id$ 
    135131   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    136    !!---------------------------------------------------------------------- 
    137 CONTAINS 
    138  
    139    SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5,   & 
    140       &                 cd6, cd7, cd8, cd9, cd10 ) 
    141       !!---------------------------------------------------------------------- 
    142       !!                  ***  ROUTINE  stop_opa  *** 
    143       !! 
    144       !! ** Purpose :   print in ocean.outpput file a error message and  
    145       !!                increment the error number (nstop) by one. 
    146       !!---------------------------------------------------------------------- 
    147       CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5 
    148       CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10 
    149       !!---------------------------------------------------------------------- 
    150       ! 
    151       nstop = nstop + 1  
    152       IF(lwp) THEN 
    153          WRITE(numout,cform_err) 
    154          IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1 
    155          IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2 
    156          IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3 
    157          IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4 
    158          IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5 
    159          IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6 
    160          IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7 
    161          IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8 
    162          IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9 
    163          IF( PRESENT(cd10) ) WRITE(numout,*) cd10 
    164       ENDIF 
    165                                CALL FLUSH(numout    ) 
    166       IF( numstp     /= -1 )   CALL FLUSH(numstp    ) 
    167       IF( numsol     /= -1 )   CALL FLUSH(numsol    ) 
    168       IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice) 
    169       ! 
    170    END SUBROUTINE ctl_stop 
    171  
    172  
    173    SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5,   & 
    174       &                 cd6, cd7, cd8, cd9, cd10 ) 
    175       !!---------------------------------------------------------------------- 
    176       !!                  ***  ROUTINE  stop_warn  *** 
    177       !! 
    178       !! ** Purpose :   print in ocean.outpput file a error message and  
    179       !!                increment the warning number (nwarn) by one. 
    180       !!---------------------------------------------------------------------- 
    181       CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5 
    182       CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10 
    183       !!---------------------------------------------------------------------- 
    184       !  
    185       nwarn = nwarn + 1  
    186       IF(lwp) THEN 
    187          WRITE(numout,cform_war) 
    188          IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1 
    189          IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2 
    190          IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3 
    191          IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4 
    192          IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5 
    193          IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6 
    194          IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7 
    195          IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8 
    196          IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9 
    197          IF( PRESENT(cd10) ) WRITE(numout,*) cd10 
    198       ENDIF 
    199       CALL FLUSH(numout) 
    200       ! 
    201    END SUBROUTINE ctl_warn 
    202  
    203  
    204    SUBROUTINE ctl_opn( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea ) 
    205       !!---------------------------------------------------------------------- 
    206       !!                  ***  ROUTINE ctl_opn  *** 
    207       !! 
    208       !! ** Purpose :   Open file and check if required file is available. 
    209       !! 
    210       !! ** Method  :   Fortan open 
    211       !!---------------------------------------------------------------------- 
    212       INTEGER          , INTENT(  out) ::   knum      ! logical unit to open 
    213       CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open 
    214       CHARACTER(len=*) , INTENT(in   ) ::   cdstat    ! disposition specifier 
    215       CHARACTER(len=*) , INTENT(in   ) ::   cdform    ! formatting specifier 
    216       CHARACTER(len=*) , INTENT(in   ) ::   cdacce    ! access specifier 
    217       INTEGER          , INTENT(in   ) ::   klengh    ! record length 
    218       INTEGER          , INTENT(in   ) ::   kout      ! number of logical units for write 
    219       LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print 
    220       INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number 
    221       !! 
    222       CHARACTER(len=80) ::   clfile 
    223       INTEGER           ::   iost 
    224       !!---------------------------------------------------------------------- 
    225  
    226       ! adapt filename 
    227       ! ---------------- 
    228       clfile = TRIM(cdfile) 
    229       IF( PRESENT( karea ) ) THEN 
    230          IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1 
    231       ENDIF 
    232 #if defined key_agrif 
    233       IF( .NOT. Agrif_Root() )   clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile) 
    234       knum=Agrif_Get_Unit() 
    235 #else 
    236       knum=getunit() 
    237 #endif 
    238  
    239       iost=0 
    240       IF( cdacce(1:6) == 'DIRECT' )  THEN 
    241          OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost ) 
    242       ELSE 
    243          OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat             , ERR=100, IOSTAT=iost ) 
    244       ENDIF 
    245       IF( iost == 0 ) THEN 
    246          IF(ldwp) THEN 
    247             WRITE(kout,*) '     file   : ', clfile,' open ok' 
    248             WRITE(kout,*) '     unit   = ', knum 
    249             WRITE(kout,*) '     status = ', cdstat 
    250             WRITE(kout,*) '     form   = ', cdform 
    251             WRITE(kout,*) '     access = ', cdacce 
    252             WRITE(kout,*) 
    253          ENDIF 
    254       ENDIF 
    255 100   CONTINUE 
    256       IF( iost /= 0 ) THEN 
    257          IF(ldwp) THEN 
    258             WRITE(kout,*) 
    259             WRITE(kout,*) ' ===>>>> : bad opening file: ', clfile 
    260             WRITE(kout,*) ' =======   ===  ' 
    261             WRITE(kout,*) '           unit   = ', knum 
    262             WRITE(kout,*) '           status = ', cdstat 
    263             WRITE(kout,*) '           form   = ', cdform 
    264             WRITE(kout,*) '           access = ', cdacce 
    265             WRITE(kout,*) '           iostat = ', iost 
    266             WRITE(kout,*) '           we stop. verify the file ' 
    267             WRITE(kout,*) 
    268          ENDIF 
    269          STOP 'ctl_opn bad opening' 
    270       ENDIF 
    271        
    272    END SUBROUTINE ctl_opn 
    273  
    274  
    275    FUNCTION getunit() 
    276       !!---------------------------------------------------------------------- 
    277       !!                  ***  FUNCTION  getunit  *** 
    278       !! 
    279       !! ** Purpose :   return the index of an unused logical unit 
    280       !!---------------------------------------------------------------------- 
    281       INTEGER :: getunit 
    282       LOGICAL :: llopn  
    283       !!---------------------------------------------------------------------- 
    284       ! 
    285       getunit = 15   ! choose a unit that is big enough then it is not already used in NEMO 
    286       llopn = .TRUE. 
    287       DO WHILE( (getunit < 998) .AND. llopn ) 
    288          getunit = getunit + 1 
    289          INQUIRE( unit = getunit, opened = llopn ) 
    290       END DO 
    291       IF( (getunit == 999) .AND. llopn ) THEN 
    292          CALL ctl_stop( 'getunit: All logical units until 999 are used...' ) 
    293          getunit = -1 
    294       ENDIF 
    295       ! 
    296    END FUNCTION getunit 
    297  
    298132   !!===================================================================== 
    299133END MODULE in_out_manager 

  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r2586 r2715  
    1818   !!   iom_rstput     : write a field in a restart file (interfaced to several routines) 
    1919   !!-------------------------------------------------------------------- 
    20    USE in_out_manager  ! I/O manager 
    2120   USE dom_oce         ! ocean space and time domain 
    2221   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    … …  
    2524   USE iom_nf90        ! NetCDF format with native NetCDF library 
    2625   USE iom_rstdimg     ! restarts access direct format "dimg" style... 
    27  
     26   USE in_out_manager  ! I/O manager 
     27   USE lib_mpp           ! MPP library 
    2828#if defined key_iomput 
    2929   USE sbc_oce, ONLY :   nn_fsbc         ! ocean space and time domain 
    … …  
    887887      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    888888      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    889       REAL(wp)        , INTENT(in), DIMENSION(        jpk) ::   pvar     ! written field 
     889      REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
    890890      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    891891      INTEGER :: ivid   ! variable id 
    … …  
    909909      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    910910      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    911       REAL(wp)        , INTENT(in), DIMENSION(jpi,jpj    ) ::   pvar     ! written field 
     911      REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
    912912      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    913913      INTEGER :: ivid   ! variable id 
    … …  
    931931      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    932932      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    933       REAL(wp)        , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvar     ! written field 
     933      REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
    934934      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    935935      INTEGER :: ivid   ! variable id 
    … …  
    964964   SUBROUTINE iom_p2d( cdname, pfield2d ) 
    965965      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    966       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfield2d 
     966      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    967967#if defined key_iomput 
    968968      CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) ) 
    … …  
    974974   SUBROUTINE iom_p3d( cdname, pfield3d ) 
    975975      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    976       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   pfield3d 
     976      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    977977#if defined key_iomput 
    978978      CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90

    r2528 r2715  
    1818   !!   iom_rstput     : write a field in a restart file (interfaced to several routines) 
    1919   !!-------------------------------------------------------------------- 
    20    USE in_out_manager  ! I/O manager 
    2120   USE dom_oce         ! ocean space and time domain 
    2221   USE iom_def         ! iom variables definitions 
    2322   USE ioipsl          ! IOIPSL library 
     23   USE in_out_manager  ! I/O manager 
     24   USE lib_mpp         ! MPP library 
    2425 
    2526   IMPLICIT NONE 

  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r2528 r2715  
    1818   !!   iom_rstput     : write a field in a restart file (interfaced to several routines) 
    1919   !!-------------------------------------------------------------------- 
    20    USE in_out_manager  ! I/O manager 
    2120   USE dom_oce         ! ocean space and time domain 
    2221   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    2322   USE iom_def         ! iom variables definitions 
    2423   USE netcdf          ! NetCDF library 
     24   USE in_out_manager  ! I/O manager 
     25   USE lib_mpp         ! MPP library 
    2526 
    2627   IMPLICIT NONE 

  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90

    r2528 r2715  
    1616   !!-------------------------------------------------------------------- 
    1717   USE in_out_manager  ! I/O manager 
     18   USE lib_mpp         ! MPP library 
    1819   USE dom_oce         ! ocean space and time domain 
    1920   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    … …  
    8283      llclobber = ldwrt .AND. ln_clobber 
    8384      ! get a free unit 
    84       idrst = getunit()  ! get a free logical unit for the restart file 
     85      idrst = get_unit()  ! get a free logical unit for the restart file 
    8586!!$#if defined key_agrif  
    8687!!$      idrst = Agrif_Get_Unit()       
    … …  
    418419      CHARACTER(len=*)                , INTENT(in)           ::   cdvar    ! time axis name 
    419420      INTEGER                         , INTENT(in)           ::   kvid     ! variable id 
    420       REAL(wp), DIMENSION(        jpk), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field 
    421       REAL(wp), DIMENSION(jpi,jpj    ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field 
    422       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field 
     421      REAL(wp), DIMENSION(          :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field 
     422      REAL(wp), DIMENSION(:  ,:      ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field 
     423      REAL(wp), DIMENSION(:  ,:  ,:  ), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field 
    423424      ! 
    424425      CHARACTER(LEN=100)    ::   clinfo               ! info character 

  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90

    r2528 r2715  
    11MODULE prtctl 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE prtctl   *** 
    4    !! Ocean system   : print all SUM trends for each processor domain 
    5    !!============================================================================== 
     4   !! Ocean system : print all SUM trends for each processor domain 
     5   !!====================================================================== 
     6   !! History :  9.0  !  05-07  (C. Talandier) original code 
     7   !!---------------------------------------------------------------------- 
    68   USE dom_oce          ! ocean space and time domain variables 
    79   USE in_out_manager   ! I/O manager 
    … …  
    1113   PRIVATE 
    1214 
    13    !! * Module declaration 
    14    INTEGER, DIMENSION(:), ALLOCATABLE :: numid 
    15    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   &  !: 
    16       nlditl , nldjtl ,   &  !: first, last indoor index for each i-domain 
    17       nleitl , nlejtl ,   &  !: first, last indoor index for each j-domain 
    18       nimpptl, njmpptl,   &  !: i-, j-indexes for each processor 
    19       nlcitl , nlcjtl ,   &  !: dimensions of every subdomain 
    20       ibonitl, ibonjtl 
    21  
    22    REAL(wp), DIMENSION(:), ALLOCATABLE ::   &  !: 
    23       t_ctll , s_ctll ,   &  !: previous trend values 
    24       u_ctll , v_ctll 
    25  
    26    INTEGER ::   ktime        !: time step 
    27  
    28    !! * Routine accessibility 
     15   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   numid 
     16   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlditl , nldjtl    ! first, last indoor index for each i-domain 
     17   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nleitl , nlejtl    ! first, last indoor index for each j-domain 
     18   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nimpptl, njmpptl   ! i-, j-indexes for each processor 
     19   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlcitl , nlcjtl    ! dimensions of every subdomain 
     20   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   ibonitl, ibonjtl   ! 
     21 
     22   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   t_ctll , s_ctll    ! previous tracer trend values 
     23   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   u_ctll , v_ctll    ! previous velocity trend values 
     24 
     25   INTEGER ::   ktime   ! time step 
     26 
    2927   PUBLIC prt_ctl         ! called by all subroutines 
    3028   PUBLIC prt_ctl_info    ! called by all subroutines 
    3129   PUBLIC prt_ctl_init    ! called by opa.F90 
     30 
    3231   !!---------------------------------------------------------------------- 
    3332   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3433   !! $Id$  
    35    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     34   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3635   !!---------------------------------------------------------------------- 
    37  
    38  
    3936CONTAINS 
    4037 
    41    SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2, mask2, clinfo2, ovlap, kdim, clinfo3) 
     38   SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2,   & 
     39      &                                  mask2, clinfo2, ovlap, kdim, clinfo3 ) 
    4240      !!---------------------------------------------------------------------- 
    4341      !!                     ***  ROUTINE prt_ctl  *** 
    … …  
    7472      !!                    kdim    : k- direction for 3D arrays  
    7573      !!                    clinfo3 : additional information  
    76       !! 
    77       !! History : 
    78       !!   9.0  !  05-07  (C. Talandier) original code 
    79       !!---------------------------------------------------------------------- 
    80       !! * Arguments 
    81       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL :: tab2d_1 
    82       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_1 
    83       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask1 
    84       CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo1 
    85       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL :: tab2d_2 
    86       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_2 
    87       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask2 
    88       CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo2 
    89       INTEGER                   , INTENT(in), OPTIONAL :: ovlap 
    90       INTEGER                   , INTENT(in), OPTIONAL :: kdim 
    91       CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo3 
    92  
    93       !! * Local declarations 
    94       INTEGER :: overlap, jn, sind, eind, kdir,j_id 
     74      !!---------------------------------------------------------------------- 
     75      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     76      USE wrk_nemo, ONLY:   ztab2d_1 => wrk_2d_30 , ztab2d_2 => wrk_2d_31 
     77      USE wrk_nemo, ONLY:   zmask1   => wrk_3d_11 , zmask2   => wrk_3d_12  
     78      USE wrk_nemo, ONLY:   ztab3d_1 => wrk_3d_13 , ztab3d_2 => wrk_3d_14 
     79      ! 
     80      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_1 
     81      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_1 
     82      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask1 
     83      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo1 
     84      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_2 
     85      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_2 
     86      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask2 
     87      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo2 
     88      INTEGER                   , INTENT(in), OPTIONAL ::   ovlap 
     89      INTEGER                   , INTENT(in), OPTIONAL ::   kdim 
     90      CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo3 
     91      ! 
    9592      CHARACTER (len=15) :: cl2 
     93      INTEGER ::   overlap, jn, sind, eind, kdir,j_id 
    9694      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 
    97       REAL(wp), DIMENSION(jpi,jpj) :: ztab2d_1, ztab2d_2 
    98       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2 
    99       !!---------------------------------------------------------------------- 
     95      !!---------------------------------------------------------------------- 
     96 
     97      IF( wrk_in_use(2, 30,31) .OR. wrk_in_use(3, 11,12,13,14) ) THEN 
     98         CALL ctl_stop('prt_ctl : requested workspace arrays unavailable')   ;   RETURN 
     99      ENDIF 
    100100 
    101101      ! Arrays, scalars initialization  
    … …  
    115115 
    116116      ! Control of optional arguments 
    117       IF( PRESENT(clinfo2) )  cl2            = clinfo2 
    118       IF( PRESENT(ovlap)   )  overlap        = ovlap 
    119       IF( PRESENT(kdim)    )  kdir           = kdim 
    120       IF( PRESENT(tab2d_1) )  ztab2d_1(:,:)  = tab2d_1(:,:) 
    121       IF( PRESENT(tab2d_2) )  ztab2d_2(:,:)  = tab2d_2(:,:) 
    122       IF( PRESENT(tab3d_1) )  ztab3d_1(:,:,1:kdir)= tab3d_1(:,:,:) 
    123       IF( PRESENT(tab3d_2) )  ztab3d_2(:,:,1:kdir)= tab3d_2(:,:,:) 
    124       IF( PRESENT(mask1)   )  zmask1  (:,:,:)= mask1  (:,:,:) 
    125       IF( PRESENT(mask2)   )  zmask2  (:,:,:)= mask2  (:,:,:) 
    126  
    127       IF( lk_mpp )   THEN 
    128          ! processor number 
     117      IF( PRESENT(clinfo2) )   cl2                  = clinfo2 
     118      IF( PRESENT(ovlap)   )   overlap              = ovlap 
     119      IF( PRESENT(kdim)    )   kdir                 = kdim 
     120      IF( PRESENT(tab2d_1) )   ztab2d_1(:,:)        = tab2d_1(:,:) 
     121      IF( PRESENT(tab2d_2) )   ztab2d_2(:,:)        = tab2d_2(:,:) 
     122      IF( PRESENT(tab3d_1) )   ztab3d_1(:,:,1:kdir) = tab3d_1(:,:,:) 
     123      IF( PRESENT(tab3d_2) )   ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,:) 
     124      IF( PRESENT(mask1)   )   zmask1  (:,:,:)      = mask1  (:,:,:) 
     125      IF( PRESENT(mask2)   )   zmask2  (:,:,:)      = mask2  (:,:,:) 
     126 
     127      IF( lk_mpp ) THEN       ! processor number 
    129128         sind = narea 
    130129         eind = narea 
    131       ELSE 
    132          ! processors total number 
     130      ELSE                    ! processors total number 
    133131         sind = 1 
    134132         eind = ijsplt 
    … …  
    206204      ENDDO 
    207205 
     206      IF( wrk_not_released(2, 30,31)     .OR.   & 
     207          wrk_not_released(3, 11,12,13,14) )   CALL ctl_stop('prt_ctl: failed to release workspace arrays') 
     208      ! 
    208209   END SUBROUTINE prt_ctl 
    209210 
    … …  
    220221      !!                    clinfo2 : information about the ivar2 
    221222      !!                    ivar2   : value to print 
    222       !! 
    223       !! History : 
    224       !!   9.0  !  05-07  (C. Talandier) original code 
    225       !!---------------------------------------------------------------------- 
    226       !! * Arguments 
    227       CHARACTER (len=*), INTENT(in) ::   clinfo1 
     223      !!---------------------------------------------------------------------- 
     224      CHARACTER (len=*), INTENT(in)           ::   clinfo1 
    228225      INTEGER          , INTENT(in), OPTIONAL ::   ivar1 
    229226      CHARACTER (len=*), INTENT(in), OPTIONAL ::   clinfo2 
    230227      INTEGER          , INTENT(in), OPTIONAL ::   ivar2 
    231228      INTEGER          , INTENT(in), OPTIONAL ::   itime 
    232  
    233       !! * Local declarations 
     229      ! 
    234230      INTEGER :: jn, sind, eind, iltime, j_id 
    235231      !!---------------------------------------------------------------------- 
    236232 
    237       IF( lk_mpp )   THEN 
    238          ! processor number 
     233      IF( lk_mpp ) THEN       ! processor number 
    239234         sind = narea 
    240235         eind = narea 
    241       ELSE 
    242          ! total number of processors 
     236      ELSE                    ! total number of processors 
    243237         sind = 1 
    244238         eind = ijsplt 
    … …  
    257251      ! Loop over each sub-domain, i.e. number of processors ijsplt 
    258252      DO jn = sind, eind 
    259           
    260          ! Set logical unit 
    261          j_id = numid(jn - narea + 1) 
    262  
     253         ! 
     254         j_id = numid(jn - narea + 1)         ! Set logical unit 
     255         ! 
    263256         IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN 
    264257            WRITE(j_id,*)clinfo1, ivar1, clinfo2, ivar2 
    … …  
    272265            WRITE(j_id,*)clinfo1 
    273266         ENDIF 
    274  
    275       ENDDO 
    276  
    277  
    278       END SUBROUTINE prt_ctl_info 
     267         ! 
     268      END DO 
     269      ! 
     270   END SUBROUTINE prt_ctl_info 
     271 
    279272 
    280273   SUBROUTINE prt_ctl_init 
    … …  
    283276      !! 
    284277      !! ** Purpose :   open ASCII files & compute indices 
    285       !! 
    286       !! History : 
    287       !!   9.0  !  05-07  (C. Talandier) original code 
    288       !!---------------------------------------------------------------------- 
    289       !! * Local declarations 
     278      !!---------------------------------------------------------------------- 
    290279      INTEGER ::   jn, sind, eind, j_id 
    291280      CHARACTER (len=28) :: clfile_out 
    … …  
    295284 
    296285      ! Allocate arrays 
    297       ALLOCATE(nlditl (ijsplt)) 
    298       ALLOCATE(nldjtl (ijsplt)) 
    299       ALLOCATE(nleitl (ijsplt)) 
    300       ALLOCATE(nlejtl (ijsplt)) 
    301       ALLOCATE(nimpptl(ijsplt)) 
    302       ALLOCATE(njmpptl(ijsplt)) 
    303       ALLOCATE(nlcitl (ijsplt)) 
    304       ALLOCATE(nlcjtl (ijsplt)) 
    305       ALLOCATE(t_ctll (ijsplt)) 
    306       ALLOCATE(s_ctll (ijsplt)) 
    307       ALLOCATE(u_ctll (ijsplt)) 
    308       ALLOCATE(v_ctll (ijsplt)) 
    309       ALLOCATE(ibonitl(ijsplt)) 
    310       ALLOCATE(ibonjtl(ijsplt)) 
     286      ALLOCATE( nlditl(ijsplt) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   & 
     287         &      nldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   & 
     288         &      nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll (ijsplt) ,                     & 
     289         &      nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll (ijsplt)                       ) 
    311290 
    312291      ! Initialization  
    313       t_ctll(:)=0.e0 
    314       s_ctll(:)=0.e0 
    315       u_ctll(:)=0.e0 
    316       v_ctll(:)=0.e0 
     292      t_ctll(:) = 0.e0 
     293      s_ctll(:) = 0.e0 
     294      u_ctll(:) = 0.e0 
     295      v_ctll(:) = 0.e0 
    317296      ktime = 1 
    318297 
    … …  
    345324      ENDIF 
    346325 
    347       ALLOCATE(numid(eind-sind+1)) 
     326      ALLOCATE( numid(eind-sind+1) ) 
    348327 
    349328      DO jn = sind, eind 
    … …  
    3923719003     FORMAT(a20,i4.4,a17,i4.4) 
    3933729004     FORMAT(a11,i4.4,a26,i4.4,a14) 
    394       ENDDO 
    395  
     373      END DO 
     374      ! 
    396375   END SUBROUTINE prt_ctl_init 
    397376 
    … …  
    434413      !!   8.5  !  02-08  (G. Madec)  F90 : free form 
    435414      !!---------------------------------------------------------------------- 
    436       !! * Local variables 
    437415      INTEGER ::   ji, jj, jn               ! dummy loop indices 
    438416      INTEGER ::   & 
    … …  
    443421         nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    444422 
    445       INTEGER, DIMENSION(:,:), ALLOCATABLE ::   & 
    446          iimpptl, ijmpptl, ilcitl, ilcjtl       ! temporary workspace 
     423      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace 
    447424      REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    448425      !!---------------------------------------------------------------------- 
    … …  
    564541         nlejtl(jn) = nlejl 
    565542      END DO 
    566  
    567       DEALLOCATE(iimpptl) 
    568       DEALLOCATE(ijmpptl) 
    569       DEALLOCATE(ilcitl) 
    570       DEALLOCATE(ilcjtl) 
    571  
     543      ! 
     544      DEALLOCATE( iimpptl, ijmpptl, ilcitl, ilcjtl ) 
     545      ! 
    572546   END SUBROUTINE sub_dom 
    573547 
     548   !!====================================================================== 
    574549END MODULE prtctl 
Note: See TracChangeset for help on using the changeset viewer.