Ignore:
Timestamp:
Dec 6, 2022, 12:01:16 AM (22 months ago)
Author:
lguez
Message:

Sync latest trunk changes to Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Ocean_skin

  • LMDZ6/branches/Ocean_skin/libf/dyn3d_common/grilles_gcm_netcdf_sub.F90

    r3811 r4368  
    22! $Id: $
    33!
    4 ! This subroutine creates the file grilles_gcm.nc containg longitudes and
    5 ! latitudes in degrees for grid u and v. This subroutine is called from
    6 ! ce0l. This subroutine corresponds to the first
    7 ! part in the program create_fausse_var.
     4! This subroutine creates the grilles_gcm.nc file, containing:
     5! -> longitudes and latitudes in degrees for dynamical grids u, v and scalaire,
     6! and the following variables added for INCA (informative anyway)
     7! -> vertical levels "presnivs"
     8! -> mask (land/sea), area (grid), phis=surface geopotential height = phis/g
    89!
     10! The subroutine is called in dynphy_lonlat/phylmd/ce0l.F90.
     11
    912SUBROUTINE grilles_gcm_netcdf_sub(masque,phis)
    1013
    1114  USE comconst_mod, ONLY: cpp, kappa, g, omeg, daysec, rad, pi
    1215  USE comvert_mod, ONLY: presnivs, preff, pa
     16  use netcdf, only: nf90_def_var, nf90_int, nf90_float, nf90_put_var
    1317 
    1418  IMPLICIT NONE
    … …  
    1923  INCLUDE "netcdf.inc"
    2024
    21 
     25!========================
    2226  REAL,DIMENSION(iip1,jjp1),INTENT(IN)  :: masque ! masque terre/mer
    2327  REAL,DIMENSION(iip1,jjp1),INTENT(IN)  :: phis   ! geopotentiel au sol
    2428
    25   REAL temp(iim+1,jjm+1)
    26   ! Attributs netcdf sortie
     29  INTEGER status,i,j
     30 
     31  ! Attributs netcdf output
    2732  INTEGER ncid_out,rcode_out
    28   INTEGER out_lonuid,out_lonvid,out_latuid,out_latvid,out_levid
    29   INTEGER out_varid
     33 
     34  INTEGER out_lonuid,out_lonvid,out_latuid,out_latvid
     35  INTEGER out_uid,out_vid,out_tempid
    3036  INTEGER out_lonudim,out_lonvdim
    31   INTEGER out_latudim,out_latvdim,out_dim(3)
     37  INTEGER out_latudim,out_latvdim,out_dim(2)
    3238  INTEGER out_levdim
    33 
    34   INTEGER start(4),COUNT(4)
    35 
    36   INTEGER status,i,j
    37   REAL rlatudeg(jjp1),rlatvdeg(jjm),rlevdeg(llm)
     39  !
     40  INTEGER :: presnivs_id
     41  INTEGER :: mask_id,area_id,phis_id
     42  !
     43  INTEGER start(2),COUNT(2)
     44
     45  ! Variables
     46  REAL rlatudeg(jjp1),rlatvdeg(jjm),rlev(llm)
    3847  REAL rlonudeg(iip1),rlonvdeg(iip1)
    39 
    40   REAL dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1)
    41   REAL acoslat,dxkm,dykm,resol(iip1,jjp1)
    42   REAL,DIMENSION(iip1,jjp1)  :: phis_loc
     48  REAL uwnd(iip1,jjp1),vwnd(iip1,jjm),temp(iip1,jjp1)
     49  !
    4350  INTEGER masque_int(iip1,jjp1)
    44   INTEGER :: phis_id
    45   INTEGER :: area_id
    46   INTEGER :: mask_id
    47   INTEGER :: presnivs_id
    48  
     51  REAL :: phis_loc(iip1,jjp1)
     52 
     53  !========================
     54  ! CALCULATION of latu, latv, lonu, lonv in deg.
     55  ! ---------------------------------------------------
    4956  rad = 6400000
    5057  omeg = 7.272205e-05
    … …  
    6471     rlatudeg(j)=rlatu(j)*180./pi
    6572  ENDDO
     73 
    6674  DO j=1,jjm
    6775     rlatvdeg(j)=rlatv(j)*180./pi
    … …  
    7280     rlonvdeg(i)=rlonv(i)*180./pi + 360.
    7381  ENDDO
    74 
    75 
    76   !  2 ----- OUVERTURE DE LA SORTIE NETCDF
    77   ! ---------------------------------------------------
    78   ! CREATION OUTPUT
    79   ! ouverture fichier netcdf de sortie out
     82 
     83  ! CALCULATION of "false" variables on u, v, s grids
     84  ! ---------------------------------------------------
     85   DO i=1,iip1
     86     DO j=1,jjp1
     87        uwnd(i,j)=MOD(i,2)+MOD(j,2)
     88        temp(i,j)=MOD(i,2)+MOD(j,2)
     89     ENDDO
     90     DO j=1,jjm
     91        vwnd(i,j)=MOD(i,2)+MOD(j,2)
     92     END DO
     93  ENDDO 
     94
     95  ! CALCULATION of local vars for presnivs, mask, sfc. geopot. height
     96  ! ---------------------------------------------------
     97  rlev(:) = presnivs(:)
     98  phis_loc(:,:) = phis(:,:)/g
     99  masque_int(:,:) = nINT(masque(:,:))
     100
     101
     102  ! OPEN output netcdf file
     103  !-------------------------
    80104  status=NF_CREATE('grilles_gcm.nc',IOR(NF_CLOBBER,NF_64BIT_OFFSET),ncid_out)
    81105  CALL handle_err(status)
     106 
     107  ! DEFINE output dimensions
     108  !-------------------------
    82109  status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim)
    83110  CALL handle_err(status)
    … …  
    88115  status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim)
    89116  CALL handle_err(status)
    90 
    91 
    92   !   Longitudes en u
    93   status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim, out_lonuid)
     117  !
     118  status=NF_DEF_DIM(ncid_out,'lev',llm,out_levdim)
     119  CALL handle_err(status)
     120 
     121  ! DEFINE output variables
     122  !-------------------------
     123  !   Longitudes on "u" dynamical grid
     124  status=NF90_DEF_VAR(ncid_out,'lonu',NF90_FLOAT,out_lonudim, out_lonuid)
    94125  CALL handle_err(status)
    95126  status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units', 12,'degrees_east')
    96   status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',9,'Longitude en u')
    97 
    98   !   Longitudes en v
    99   status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim, out_lonvid)
     127  status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',19,'Longitude on u grid')
     128  !   Longitudes on "v" dynamical grid
     129  status=NF90_DEF_VAR(ncid_out,'lonv',NF90_FLOAT,out_lonvdim, out_lonvid)
    100130  CALL handle_err(status)
    101131  status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units', 12,'degrees_east')
    102   status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name', 9,'Longitude en v')
    103 
    104   !   Latitude en u
    105   status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim, out_latuid)
     132  status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name', 19,'Longitude on v grid')
     133  !   Latitudes on "u" dynamical grid
     134  status=NF90_DEF_VAR(ncid_out,'latu',NF90_FLOAT,out_latudim, out_latuid)
    106135  CALL handle_err(status)
    107136  status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units', 13,'degrees_north')
    108   status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name', 8,'Latitude en u')
    109 
    110   !  Latitude en v
    111   status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim, out_latvid)
     137  status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name', 18,'Latitude on u grid')
     138  !  Latitudes on "v" dynamical grid
     139  status=NF90_DEF_VAR(ncid_out,'latv',NF90_FLOAT,out_latvdim, out_latvid)
    112140  CALL handle_err(status)
    113141  status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units', 13,'degrees_north')
    114   status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name', 8,'Latitude en v')
    115 
    116   !   ecriture de la grille u
     142  status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name', 18,'Latitude on v grid')
     143  !  "u" lat/lon dynamical grid
    117144  out_dim(1)=out_lonudim
    118145  out_dim(2)=out_latudim
    119   status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim, out_varid)
    120   CALL handle_err(status)
    121   status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
    122   status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point u')
    123 
    124   !   ecriture de la grille v
     146  status=NF90_DEF_VAR(ncid_out,'grille_u',NF90_FLOAT,out_dim, out_uid)
     147  CALL handle_err(status)
     148  status=NF_PUT_ATT_TEXT(ncid_out,out_uid,'units', 3,'m/s')
     149  status=NF_PUT_ATT_TEXT(ncid_out,out_uid,'long_name', 21,'u-wind dynamical grid')
     150  !  "v" lat/lon dynamical grid
    125151  out_dim(1)=out_lonvdim
    126152  out_dim(2)=out_latvdim
    127   status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim, out_varid)
    128   CALL handle_err(status)
    129   status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
    130   status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point v')
    131 
    132   !   ecriture de la grille u
     153  status=NF90_DEF_VAR(ncid_out,'grille_v',NF90_FLOAT,out_dim, out_vid)
     154  CALL handle_err(status)
     155  status=NF_PUT_ATT_TEXT(ncid_out,out_vid,'units', 3,'m/s')
     156  status=NF_PUT_ATT_TEXT(ncid_out,out_vid,'long_name', 21,'v-wind dynamical grid')
     157  !  "s" (scalar) lat/lon dynamical grid
    133158  out_dim(1)=out_lonvdim
    134159  out_dim(2)=out_latudim
    135   status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim, out_varid)
    136   CALL handle_err(status)
    137   status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
    138   status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',16,'Grille aux point u')
    139 
    140   status=NF_ENDDEF(ncid_out)
    141   write(*,*) "COUCOU 6"
    142   CALL handle_err(status)
    143   ! 5) ----- FERMETURE DES FICHIERS NETCDF------------------
    144   ! --------------------------------------------------------
    145   ! 3-b- Ecriture de la grille pour la sortie
    146   ! rajoute l'ecriture de la grille
    147 
    148 #ifdef NC_DOUBLE
    149   status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonuid,1,iim+1,rlonudeg)
    150   CALL handle_err(status)
    151   status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
    152   CALL handle_err(status)
    153   status=NF_PUT_VARA_DOUBLE(ncid_out,out_latuid,1,jjm+1,rlatudeg)
    154   CALL handle_err(status)
    155   status=NF_PUT_VARA_DOUBLE(ncid_out,out_latvid,1,jjm,rlatvdeg)
    156   CALL handle_err(status)
    157 #else
    158   status=NF_PUT_VARA_REAL(ncid_out,out_lonuid,1,iim+1,rlonudeg)
    159   CALL handle_err(status)
    160   status=NF_PUT_VARA_REAL(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
    161   CALL handle_err(status)
    162   status=NF_PUT_VARA_REAL(ncid_out,out_latuid,1,jjm+1,rlatudeg)
    163   CALL handle_err(status)
    164   status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg)
    165   CALL handle_err(status)
    166 #endif
    167 
    168   start(1)=1
    169   start(2)=1
    170   start(3)=1
    171   start(4)=1
    172 
    173   COUNT(1)=iim+1
    174   COUNT(2)=jjm+1
    175   COUNT(3)=1
    176   COUNT(4)=1
    177 
    178   DO j=1,jjm+1
    179      DO i=1,iim+1
    180         temp(i,j)=MOD(i,2)+MOD(j,2)
    181      ENDDO
    182   ENDDO
    183 
    184 #ifdef NC_DOUBLE
    185   status=NF_PUT_VARA_DOUBLE(ncid_out,out_varid,start, count,temp)
    186   CALL handle_err(status)
    187 #else
    188   status=NF_PUT_VARA_REAL(ncid_out,out_varid,start, count,temp)
    189   CALL handle_err(status)
    190 #endif
    191 
    192   ! On re-ouvre le fichier pour rajouter 4 nouvelles variables necessaire pour INCA
    193 ! lev - phis - aire - mask
    194 ! rlevdeg(:) = presnivs
    195   rlevdeg(:) = presnivs(:)
    196   phis_loc(:,:) = phis(:,:)/g
    197 
    198 ! niveaux de pression verticaux
    199   status = NF_REDEF (ncid_out)
    200   CALL handle_err(status)
    201   status=NF_DEF_DIM(ncid_out,'lev',llm,out_levdim)
    202   CALL handle_err(status)
    203   status=NF_DEF_VAR(ncid_out,'presnivs',NF_FLOAT,1,out_levdim,&
    204                     presnivs_id)
    205   CALL handle_err(status)
    206  
    207 ! fields
     160  status=NF90_DEF_VAR(ncid_out,'grille_s',NF90_FLOAT,out_dim, out_tempid)
     161  CALL handle_err(status)
     162  status=NF_PUT_ATT_TEXT(ncid_out,out_tempid,'units', 6,'Kelvin')
     163  status=NF_PUT_ATT_TEXT(ncid_out,out_tempid,'long_name',21,'scalar dynamical grid')
     164  !
     165  ! for INCA :
     166  ! vertical levels "presnivs"
     167  status=NF90_DEF_VAR(ncid_out,'presnivs',NF90_FLOAT,out_levdim, presnivs_id)
     168  CALL handle_err(status)
     169  status=NF_PUT_ATT_TEXT(ncid_out,presnivs_id,'units', 2,'Pa')
     170  status=NF_PUT_ATT_TEXT(ncid_out,presnivs_id,'long_name',15,'Vertical levels')
     171  ! surface geopotential height: named "phis" as the sfc geopotential, is actually phis/g
    208172  out_dim(1)=out_lonvdim
    209173  out_dim(2)=out_latudim
    210 
    211   status = nf_def_var(ncid_out,'phis',NF_FLOAT,2,out_dim,phis_id)
    212   CALL handle_err(status)
    213   status = nf_def_var(ncid_out,'aire',NF_FLOAT,2,out_dim,area_id)
    214   CALL handle_err(status)
    215   status = nf_def_var(ncid_out,'mask',NF_INT  ,2,out_dim,mask_id)
    216   CALL handle_err(status)
    217 
    218   status=NF_ENDDEF(ncid_out)
    219   CALL handle_err(status)
    220 
    221   ! ecriture des variables
    222 #ifdef NC_DOUBLE
    223   status=NF_PUT_VARA_DOUBLE(ncid_out,presnivs_id,1,llm,rlevdeg)
    224   CALL handle_err(status)
    225 #else
    226   status=NF_PUT_VARA_REAL(ncid_out,out_levid,1,llm,rlevdeg)
    227   CALL handle_err(status)
    228 #endif
    229 
    230   start(1)=1
    231   start(2)=1
    232   start(3)=1
    233   start(4)=0
     174  status = nf90_def_var(ncid_out,'phis',NF90_FLOAT,out_dim,phis_id)
     175  CALL handle_err(status)
     176  status=NF_PUT_ATT_TEXT(ncid_out,phis_id,'units', 1,'m')
     177  status=NF_PUT_ATT_TEXT(ncid_out,phis_id,'long_name',27,'surface geopotential height')
     178  ! gridcell area
     179  status = nf90_def_var(ncid_out,'aire',NF90_FLOAT,out_dim,area_id)
     180  CALL handle_err(status)
     181  status=NF_PUT_ATT_TEXT(ncid_out,area_id,'units', 2,'m2')
     182  status=NF_PUT_ATT_TEXT(ncid_out,area_id,'long_name',13,'gridcell area')
     183  ! land-sea mask (nearest integer approx)
     184  status = nf90_def_var(ncid_out,'mask',NF90_INT,out_dim,mask_id)
     185  CALL handle_err(status)
     186  status=NF_PUT_ATT_TEXT(ncid_out,mask_id,'long_name',27,'land-sea mask (nINT approx)')
     187 
     188  ! END the 'define' mode in netCDF file
     189  status=NF_ENDDEF(ncid_out) 
     190  CALL handle_err(status)
     191 
     192  ! WRITE the variables
     193  !-------------------------
     194  ! 1D : lonu, lonv,latu,latv ; INCA : presnivs
     195  status=NF90_PUT_VAR(ncid_out,out_lonuid,rlonudeg,[1],[iip1])
     196  CALL handle_err(status)
     197  status=NF90_PUT_VAR(ncid_out,out_lonvid,rlonvdeg,[1],[iip1])
     198  CALL handle_err(status)
     199  status=NF90_PUT_VAR(ncid_out,out_latuid,rlatudeg,[1],[jjp1])
     200  CALL handle_err(status)
     201  status=NF90_PUT_VAR(ncid_out,out_latvid,rlatvdeg,[1],[jjm])
     202  CALL handle_err(status)
     203  status=NF90_PUT_VAR(ncid_out,presnivs_id,rlev,[1],[llm])
     204  CALL handle_err(status)
     205
     206  ! 2D : grille_u,grille_v,grille_s ; INCA: phis,aire,mask
     207  start(:)=1
    234208  COUNT(1)=iip1
    235   COUNT(2)=jjp1
    236   COUNT(3)=1
    237   COUNT(4)=0
    238 
    239   status = nf_put_vara_double(ncid_out, phis_id,start,count, phis_loc)
    240   CALL handle_err(status)
    241   status = nf_put_vara_double(ncid_out, area_id,start,count, aire)
    242   CALL handle_err(status)
    243   masque_int(:,:) = nINT(masque(:,:))
    244   status = nf_put_vara_int(ncid_out, mask_id,start,count,masque_int)
    245   CALL handle_err(status)
    246  
    247   ! fermeture du fichier netcdf
     209 
     210  COUNT(2)=jjp1  ! for "u" and "s" grids
     211  status=NF90_PUT_VAR(ncid_out,out_uid,uwnd,start, count)
     212  CALL handle_err(status)
     213  COUNT(2)=jjm  ! for "v" grid
     214  status=NF90_PUT_VAR(ncid_out,out_vid,vwnd,start, count)
     215  CALL handle_err(status)
     216  COUNT(2)=jjp1  ! as "s" grid, for all the following vars
     217  status=NF90_PUT_VAR(ncid_out,out_tempid,temp,start, count)
     218  CALL handle_err(status)
     219  status = nf90_put_var(ncid_out, phis_id, phis_loc,start,count)
     220  CALL handle_err(status)
     221  status = nf90_put_var(ncid_out, area_id, aire,start,count)
     222  CALL handle_err(status)
     223  status = nf90_put_var(ncid_out, mask_id,masque_int,start,count)
     224  CALL handle_err(status)
     225 
     226  ! CLOSE netcdf file
    248227  CALL ncclos(ncid_out,rcode_out)
     228  write(*,*) "END grilles_gcm_netcdf_sub OK"
    249229
    250230END SUBROUTINE grilles_gcm_netcdf_sub
    251 
    252231
    253232
Note: See TracChangeset for help on using the changeset viewer.