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 5257 for branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90 – NEMO

Ignore:
Timestamp:
2015-05-08T16:18:50+02:00 (9 years ago)
Author:
timgraham
Message:

Fixed lots of compilation errors

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90

    r5255 r5257  
    11MODULE utils 
    22 
    3    IMPLICIT NONE 
    43   USE netcdf 
    54 
     5   IMPLICIT NONE 
    66   PUBLIC             ! allows the acces to par_oce when dom_oce is used 
    77   !                  ! exception to coding rules... to be suppressed ??? 
    88 
    9    PUBLIC dom_oce_alloc 
    10    PUBLIC read_bathy 
     9!   PUBLIC dom_oce_alloc 
    1110 
     11   INTEGER, PARAMETER   :: dp=8 , sp=4, wp=dp 
    1212 
    1313   !! All coordinates 
     
    4545   INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers 
    4646   INTEGER  ::   ios                      ! Local integer output status for namelist read and allocation 
     47   INTEGER  ::   numnam                   ! File handle for namelist  
    4748   REAL(wp) ::   zrmax, ztaper   ! temporary scalars 
    4849   REAL(wp) ::   zrfact 
    4950   ! 
    50    REAL(wp), DIMENSION(:,:  ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 
    51    REAL(wp), DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat 
     51   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 
     52   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zenv, ztmp, zmsk, zri, zrj, zhbat 
     53 
     54   !Namelist variables 
     55   REAL(wp) :: rn_jpk, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax, rn_theta 
     56   REAL(wp) :: rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 
     57   LOGICAL :: ln_s_sh94, ln_s_sf12, ln_sigcrit 
    5258 
    5359   NAMELIST/namzgr_sco/rn_jpk, ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & 
    5460                        rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 
    5561 
     62   CONTAINS 
    5663 
    5764   INTEGER FUNCTION dom_oce_alloc() 
    5865      !!---------------------------------------------------------------------- 
    59       INTEGER, DIMENSION(12) :: ierr 
     66      INTEGER, DIMENSION(4) :: ierr 
    6067      !!---------------------------------------------------------------------- 
    6168      ierr(:) = 0 
    6269      ! 
    6370      ALLOCATE( zenv(jpi,jpj), ztmp(jpi,jpj), zmsk(jpi,jpj), zri(jpi,jpj), zrj(jpi,jpj), & 
    64          &      zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj) ) 
     71         &      zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj), STAT=ierr(1) ) 
    6572         ! 
    66       ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) ,                         & 
    67          &      gdept_0 (jpi,jpj,jpk) , e3t_0(jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) ,                         & 
    68          &      gdepw_0 (jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , STAT=ierr(4) ) 
     73      ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) ,                         & 
     74         &      gdept_0(jpi,jpj,jpk) , e3t_0(jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) ,                         & 
     75         &      gdepw_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , STAT=ierr(2) ) 
    6976         ! 
    7077         ! 
     
    7481         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     & 
    7582         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     & 
    76          &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(8) ) 
     83         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(3) ) 
    7784 
    78       ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(9) ) 
    79       ! 
     85      ALLOCATE( mbathy(jpi,jpj) , STAT=ierr(4) ) 
     86     ! 
    8087      dom_oce_alloc = MAXVAL(ierr) 
    8188      ! 
    8289   END FUNCTION dom_oce_alloc 
    83  
     90    
    8491 
    8592   SUBROUTINE read_bathy() 
    8693     !! Read bathymetry from input netcdf file 
    87      INTEGER :: var_id 
     94     INTEGER :: var_id, ncin 
    8895 
    89      CALL check_nf90( nf90_open('bathy.nc', NF90_NOWRITE, ncin), 'Error opening mesh_mask file' ) 
     96     CALL check_nf90( nf90_open('bathy.nc', NF90_NOWRITE, ncin), 'Error opening bathy.nc file' ) 
    9097 
    9198     ! Find the size of the input bathymetry 
     
    96103      
    97104     ! Read the bathymetry variable from file 
    98      CALL check_nf90( nf90_inq_varid( ncin, 'bathymetry', tmask_id ), 'Cannot get variable ID for bathymetry') 
     105     CALL check_nf90( nf90_inq_varid( ncin, 'bathymetry', var_id ), 'Cannot get variable ID for bathymetry') 
    99106     CALL check_nf90( nf90_get_var( ncin, var_id, bathy, (/ 1,1 /), (/ jpi, jpj /) ) ) 
     107 
     108     CALL check_nf90( nf90_close(ncin), 'Error closing bathy.nc file' ) 
    100109 
    101110   END SUBROUTINE read_bathy 
     
    113122     CALL check_nf90( nf90_inquire_dimension(ncid,id_var,len=len)) 
    114123 
    115   END SUBROUTINE dimlen 
     124   END SUBROUTINE dimlen 
     125   
     126  
     127   SUBROUTINE write_coord_file() 
     128     ! Write out variables to the a netcdf coordinates file 
     129      
     130     INTEGER :: id_x, id_y, id_z 
     131     INTEGER :: ncout 
     132     INTEGER, DIMENSION(11) :: var_ids  !Array to contain all variable IDs 
    116133 
     134     !Create the file 
     135     CALL check_nf90( nf90_create('coord_zgr.nc', NF90_CLOBBER, ncout), 'Could not create output file') 
     136     ! 
     137     !Define dimensions 
     138     CALL check_nf90( nf90_def_dim(ncout, 'x', jpi, id_x) ) 
     139     CALL check_nf90( nf90_def_dim(ncout, 'y', jpj, id_y) ) 
     140     CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) ) 
     141     ! 
     142     !Define variables 
     143     CALL check_nf90( nf90_def_var(ncout, 'gdept_0', nf90_double, (/id_x, id_y,id_x/), var_ids(1)) ) 
     144     CALL check_nf90( nf90_def_var(ncout, 'gdepw_0', nf90_double, (/id_x, id_y,id_x/), var_ids(2)) ) 
     145     CALL check_nf90( nf90_def_var(ncout, 'gdep3w_0', nf90_double, (/id_x, id_y,id_x/), var_ids(3)) ) 
     146     CALL check_nf90( nf90_def_var(ncout, 'e3f_0', nf90_double, (/id_x, id_y,id_x/), var_ids(4)) ) 
     147     CALL check_nf90( nf90_def_var(ncout, 'e3t_0', nf90_double, (/id_x, id_y,id_x/), var_ids(5)) ) 
     148     CALL check_nf90( nf90_def_var(ncout, 'e3u_0', nf90_double, (/id_x, id_y,id_x/), var_ids(6)) ) 
     149     CALL check_nf90( nf90_def_var(ncout, 'e3v_0', nf90_double, (/id_x, id_y,id_x/), var_ids(7)) ) 
     150     CALL check_nf90( nf90_def_var(ncout, 'e3w_0', nf90_double, (/id_x, id_y,id_x/), var_ids(8)) ) 
     151     CALL check_nf90( nf90_def_var(ncout, 'e3uw_0', nf90_double, (/id_x, id_y,id_x/), var_ids(9)) ) 
     152     CALL check_nf90( nf90_def_var(ncout, 'e3vw_0', nf90_double, (/id_x, id_y,id_x/), var_ids(10)) ) 
     153     CALL check_nf90( nf90_def_var(ncout, 'mbathy', nf90_double, (/id_x, id_y,id_x/), var_ids(11)) ) 
     154      
     155     ! End define mode 
     156     CALL check_nf90( nf90_enddef(ncout) ) 
    117157 
    118     
    119    SUBROUTINE write_coord_file() 
     158     !Write variables to file 
     159     CALL check_nf90( nf90_put_var(ncout, var_ids(1), gdept_0) ) 
     160     CALL check_nf90( nf90_put_var(ncout, var_ids(2), gdepw_0) ) 
     161     CALL check_nf90( nf90_put_var(ncout, var_ids(3), gdep3w_0) ) 
     162     CALL check_nf90( nf90_put_var(ncout, var_ids(4), e3f_0) ) 
     163     CALL check_nf90( nf90_put_var(ncout, var_ids(5), e3t_0) ) 
     164     CALL check_nf90( nf90_put_var(ncout, var_ids(6), e3u_0) ) 
     165     CALL check_nf90( nf90_put_var(ncout, var_ids(7), e3v_0) ) 
     166     CALL check_nf90( nf90_put_var(ncout, var_ids(8), e3w_0) ) 
     167     CALL check_nf90( nf90_put_var(ncout, var_ids(9), e3uw_0) ) 
     168     CALL check_nf90( nf90_put_var(ncout, var_ids(10), e3vw_0) ) 
     169     CALL check_nf90( nf90_put_var(ncout, var_ids(11), mbathy) ) 
     170      
     171     CALL check_nf90( nf90_close(ncout) ) 
    120172 
    121173   END SUBROUTINE write_coord_file 
     
    127179 
    128180      IF (istat /= nf90_noerr) THEN 
    129          WRITE(numerr,*) 'ERROR! : '//TRIM(nf90_strerror(istat)) 
    130          IF ( PRESENT(message) ) THEN ; WRITE(numerr,*) message ; ENDIF 
     181         WRITE(*,*) 'ERROR! : '//TRIM(nf90_strerror(istat)) 
     182         IF ( PRESENT(message) ) THEN ; WRITE(*,*) message ; ENDIF 
    131183         STOP 
    132184      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.