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

Ignore:
Timestamp:
2015-05-13T15:28:30+02:00 (9 years ago)
Author:
timgraham
Message:

Removed use of 3D variables.
Compiles and runs with no errors but still need to check output

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r5257 r5269  
    1313   !! All coordinates 
    1414   !! --------------- 
    15    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w_0           !: depth of t-points (sum of e3w) (m) 
    16    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0, gdepw_0   !: analytical (time invariant) depth at t-w  points (m) 
    17    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3v_0  , e3f_0     !: analytical (time invariant) vertical scale factors at  v-f 
    18    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_0  , e3u_0     !:                                      t-u  points (m) 
    19    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3vw_0             !: analytical (time invariant) vertical scale factors at  vw 
    20    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w_0  , e3uw_0    !:                                      w-uw points (m) 
     15   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gdep3w_0           !: depth of t-points (sum of e3w) (m) 
     16   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gdept_0, gdepw_0   !: analytical (time invariant) depth at t-w  points (m) 
     17   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3v_0  , e3f_0     !: analytical (time invariant) vertical scale factors at  v-f 
     18   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_0  , e3u_0     !:                                      t-u  points (m) 
     19   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3vw_0             !: analytical (time invariant) vertical scale factors at  vw 
     20   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3w_0  , e3uw_0    !:                                      w-uw points (m) 
    2121 
    2222   !! s-coordinate and hybrid z-s-coordinate 
    … …  
    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  
     47   INTEGER,PARAMETER  ::   numnam=8       ! File handle for namelist  
    4848   REAL(wp) ::   zrmax, ztaper   ! temporary scalars 
    4949   REAL(wp) ::   zrfact 
    … …  
    6060                        rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 
    6161 
     62  ! IDs for output netcdf file 
     63  INTEGER :: id_x, id_y, id_z 
     64  INTEGER :: ncout 
     65  INTEGER, DIMENSION(11) :: var_ids  !Array to contain all variable IDs 
     66 
    6267   CONTAINS 
    6368 
    … …  
    7176         &      zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj), STAT=ierr(1) ) 
    7277         ! 
    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) ) 
     78      ALLOCATE( gdep3w_0(jpi,jpj) , e3v_0(jpi,jpj) , e3f_0(jpi,jpj) ,                         & 
     79         &      gdept_0(jpi,jpj) , e3t_0(jpi,jpj) , e3u_0 (jpi,jpj) ,                         & 
     80         &      gdepw_0(jpi,jpj) , e3w_0(jpi,jpj) , e3vw_0(jpi,jpj) , e3uw_0(jpi,jpj) , STAT=ierr(2) ) 
    7681         ! 
    7782         ! 
    … …  
    97102 
    98103     ! Find the size of the input bathymetry 
    99      CALL dimlen(ncin, 'x', jpi)     
    100      CALL dimlen(ncin, 'y', jpj)     
     104     CALL dimlen(ncin, 'lon', jpi)     
     105     CALL dimlen(ncin, 'lat', jpj)     
    101106      
    102107     ALLOCATE( bathy(jpi, jpj) ) 
    103108      
    104109     ! Read the bathymetry variable from file 
    105      CALL check_nf90( nf90_inq_varid( ncin, 'bathymetry', var_id ), 'Cannot get variable ID for bathymetry') 
     110     CALL check_nf90( nf90_inq_varid( ncin, 'Bathymetry', var_id ), 'Cannot get variable ID for bathymetry') 
    106111     CALL check_nf90( nf90_get_var( ncin, var_id, bathy, (/ 1,1 /), (/ jpi, jpj /) ) ) 
    107112 
    … …  
    125130   
    126131  
    127    SUBROUTINE write_coord_file() 
    128      ! Write out variables to the a netcdf coordinates file 
     132   SUBROUTINE make_coord_file() 
     133     ! Create new coordinates file and define dimensions and variables ready for 
     134     ! writing 
    129135      
    130      INTEGER :: id_x, id_y, id_z 
    131      INTEGER :: ncout 
    132      INTEGER, DIMENSION(11) :: var_ids  !Array to contain all variable IDs 
    133136 
    134137     !Create the file 
    … …  
    141144     ! 
    142145     !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)) ) 
     146     CALL check_nf90( nf90_def_var(ncout, 'gdept_0', nf90_double, (/id_x, id_y,id_z/), var_ids(1)) ) 
     147     CALL check_nf90( nf90_def_var(ncout, 'gdepw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(2)) ) 
     148     CALL check_nf90( nf90_def_var(ncout, 'gdep3w_0', nf90_double, (/id_x, id_y,id_z/), var_ids(3)) ) 
     149     CALL check_nf90( nf90_def_var(ncout, 'e3f_0', nf90_double, (/id_x, id_y,id_z/), var_ids(4)) ) 
     150     CALL check_nf90( nf90_def_var(ncout, 'e3t_0', nf90_double, (/id_x, id_y,id_z/), var_ids(5)) ) 
     151     CALL check_nf90( nf90_def_var(ncout, 'e3u_0', nf90_double, (/id_x, id_y,id_z/), var_ids(6)) ) 
     152     CALL check_nf90( nf90_def_var(ncout, 'e3v_0', nf90_double, (/id_x, id_y,id_z/), var_ids(7)) ) 
     153     CALL check_nf90( nf90_def_var(ncout, 'e3w_0', nf90_double, (/id_x, id_y,id_z/), var_ids(8)) ) 
     154     CALL check_nf90( nf90_def_var(ncout, 'e3uw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(9)) ) 
     155     CALL check_nf90( nf90_def_var(ncout, 'e3vw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(10)) ) 
     156     CALL check_nf90( nf90_def_var(ncout, 'mbathy', nf90_double, (/id_x, id_y/), var_ids(11)) ) 
    154157      
    155158     ! End define mode 
    156159     CALL check_nf90( nf90_enddef(ncout) ) 
     160      
     161     WRITE(*,*) 'Opened coord_zgr.nc file and defined variables' 
    157162 
    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) ) 
     163   END SUBROUTINE make_coord_file 
    172164 
    173    END SUBROUTINE write_coord_file 
     165   SUBROUTINE write_netcdf_vars(kk) 
     166   ! Write  variables to the netcdf file at level kk 
     167     INTEGER, INTENT(in) :: kk 
     168 
     169     CALL check_nf90( nf90_put_var(ncout, var_ids(1), gdept_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     170     CALL check_nf90( nf90_put_var(ncout, var_ids(2), gdepw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     171     CALL check_nf90( nf90_put_var(ncout, var_ids(3), gdep3w_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     172     CALL check_nf90( nf90_put_var(ncout, var_ids(4), e3f_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     173     CALL check_nf90( nf90_put_var(ncout, var_ids(5), e3t_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     174     CALL check_nf90( nf90_put_var(ncout, var_ids(6), e3u_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     175     CALL check_nf90( nf90_put_var(ncout, var_ids(7), e3v_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     176     CALL check_nf90( nf90_put_var(ncout, var_ids(8), e3w_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     177     CALL check_nf90( nf90_put_var(ncout, var_ids(9), e3uw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     178     CALL check_nf90( nf90_put_var(ncout, var_ids(10), e3vw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) ) 
     179 
     180   END SUBROUTINE write_netcdf_vars 
    174181 
    175182   SUBROUTINE check_nf90( istat, message ) 
Note: See TracChangeset for help on using the changeset viewer.