Changeset 10025 for utils/tools/NESTING/src/agrif_readwrite.f90
- Timestamp:
- 2018-08-02T15:25:27+02:00 (6 years ago)
- File:
-
- 1 edited
-
utils/tools/NESTING/src/agrif_readwrite.f90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
utils/tools/NESTING/src/agrif_readwrite.f90
r9628 r10025 40 40 TYPE(Coordinates) :: Grid 41 41 ! 42 CALL Read_Ncdf_var('glamt',name,Grid%glamt)43 CALL Read_Ncdf_var('glamu',name,Grid%glamu)44 CALL Read_Ncdf_var('glamv',name,Grid%glamv)45 CALL Read_Ncdf_var('glamf',name,Grid%glamf)46 CALL Read_Ncdf_var('gphit',name,Grid%gphit)47 CALL Read_Ncdf_var('gphiu',name,Grid%gphiu)48 CALL Read_Ncdf_var('gphiv',name,Grid%gphiv)49 CALL Read_Ncdf_var('gphif',name,Grid%gphif)50 CALL Read_Ncdf_var('e1t',name,Grid%e1t)51 CALL Read_Ncdf_var('e1u',name,Grid%e1u)52 CALL Read_Ncdf_var('e1v',name,Grid%e1v)53 CALL Read_Ncdf_var('e1f',name,Grid%e1f)54 CALL Read_Ncdf_var('e2t',name,Grid%e2t)55 CALL Read_Ncdf_var('e2u',name,Grid%e2u)56 CALL Read_Ncdf_var('e2v',name,Grid%e2v)57 CALL Read_Ncdf_var('e2f',name,Grid%e2f)58 CALL Read_Ncdf_var('nav_lon',name,Grid%nav_lon)59 CALL Read_Ncdf_var('nav_lat',name,Grid%nav_lat)42 CALL read_ncdf_var('glamt',name,Grid%glamt) 43 CALL read_ncdf_var('glamu',name,Grid%glamu) 44 CALL read_ncdf_var('glamv',name,Grid%glamv) 45 CALL read_ncdf_var('glamf',name,Grid%glamf) 46 CALL read_ncdf_var('gphit',name,Grid%gphit) 47 CALL read_ncdf_var('gphiu',name,Grid%gphiu) 48 CALL read_ncdf_var('gphiv',name,Grid%gphiv) 49 CALL read_ncdf_var('gphif',name,Grid%gphif) 50 CALL read_ncdf_var('e1t',name,Grid%e1t) 51 CALL read_ncdf_var('e1u',name,Grid%e1u) 52 CALL read_ncdf_var('e1v',name,Grid%e1v) 53 CALL read_ncdf_var('e1f',name,Grid%e1f) 54 CALL read_ncdf_var('e2t',name,Grid%e2t) 55 CALL read_ncdf_var('e2u',name,Grid%e2u) 56 CALL read_ncdf_var('e2v',name,Grid%e2v) 57 CALL read_ncdf_var('e2f',name,Grid%e2f) 58 CALL read_ncdf_var('nav_lon',name,Grid%nav_lon) 59 CALL read_ncdf_var('nav_lat',name,Grid%nav_lat) 60 60 ! 61 61 IF( PRESENT(Pacifique) )THEN … … 103 103 TYPE(Coordinates) :: Grid 104 104 ! 105 CALL Read_Ncdf_var('glamt',name,Grid%glamt,strt,cnt)106 CALL Read_Ncdf_var('glamu',name,Grid%glamu,strt,cnt)107 CALL Read_Ncdf_var('glamv',name,Grid%glamv,strt,cnt)108 CALL Read_Ncdf_var('glamf',name,Grid%glamf,strt,cnt)109 CALL Read_Ncdf_var('gphit',name,Grid%gphit,strt,cnt)110 CALL Read_Ncdf_var('gphiu',name,Grid%gphiu,strt,cnt)111 CALL Read_Ncdf_var('gphiv',name,Grid%gphiv,strt,cnt)112 CALL Read_Ncdf_var('gphif',name,Grid%gphif,strt,cnt)113 CALL Read_Ncdf_var('e1t',name,Grid%e1t,strt,cnt)114 CALL Read_Ncdf_var('e1u',name,Grid%e1u,strt,cnt)115 CALL Read_Ncdf_var('e1v',name,Grid%e1v,strt,cnt)116 CALL Read_Ncdf_var('e1f',name,Grid%e1f,strt,cnt)117 CALL Read_Ncdf_var('e2t',name,Grid%e2t,strt,cnt)118 CALL Read_Ncdf_var('e2u',name,Grid%e2u,strt,cnt)119 CALL Read_Ncdf_var('e2v',name,Grid%e2v,strt,cnt)120 CALL Read_Ncdf_var('e2f',name,Grid%e2f,strt,cnt)121 CALL Read_Ncdf_var('nav_lon',name,Grid%nav_lon,strt,cnt)122 CALL Read_Ncdf_var('nav_lat',name,Grid%nav_lat,strt,cnt)105 CALL read_ncdf_var('glamt',name,Grid%glamt,strt,cnt) 106 CALL read_ncdf_var('glamu',name,Grid%glamu,strt,cnt) 107 CALL read_ncdf_var('glamv',name,Grid%glamv,strt,cnt) 108 CALL read_ncdf_var('glamf',name,Grid%glamf,strt,cnt) 109 CALL read_ncdf_var('gphit',name,Grid%gphit,strt,cnt) 110 CALL read_ncdf_var('gphiu',name,Grid%gphiu,strt,cnt) 111 CALL read_ncdf_var('gphiv',name,Grid%gphiv,strt,cnt) 112 CALL read_ncdf_var('gphif',name,Grid%gphif,strt,cnt) 113 CALL read_ncdf_var('e1t',name,Grid%e1t,strt,cnt) 114 CALL read_ncdf_var('e1u',name,Grid%e1u,strt,cnt) 115 CALL read_ncdf_var('e1v',name,Grid%e1v,strt,cnt) 116 CALL read_ncdf_var('e1f',name,Grid%e1f,strt,cnt) 117 CALL read_ncdf_var('e2t',name,Grid%e2t,strt,cnt) 118 CALL read_ncdf_var('e2u',name,Grid%e2u,strt,cnt) 119 CALL read_ncdf_var('e2v',name,Grid%e2v,strt,cnt) 120 CALL read_ncdf_var('e2f',name,Grid%e2f,strt,cnt) 121 CALL read_ncdf_var('nav_lon',name,Grid%nav_lon,strt,cnt) 122 CALL read_ncdf_var('nav_lat',name,Grid%nav_lat,strt,cnt) 123 123 ! 124 124 WRITE(*,*) ' ' … … 146 146 ! 147 147 dimnames = (/ 'x','y' /) 148 CALL Write_Ncdf_dim(dimnames(1),name,nxfin)149 CALL Write_Ncdf_dim(dimnames(2),name,nyfin)150 ! 151 CALL Write_Ncdf_var('nav_lon',dimnames,name,Grid%nav_lon,'float')152 CALL Write_Ncdf_var('nav_lat',dimnames,name,Grid%nav_lat,'float')153 ! 154 CALL Write_Ncdf_var('glamt',dimnames,name,Grid%glamt,'double')155 CALL Write_Ncdf_var('glamu',dimnames,name,Grid%glamu,'double')156 CALL Write_Ncdf_var('glamv',dimnames,name,Grid%glamv,'double')157 CALL Write_Ncdf_var('glamf',dimnames,name,Grid%glamf,'double')158 CALL Write_Ncdf_var('gphit',dimnames,name,Grid%gphit,'double')159 CALL Write_Ncdf_var('gphiu',dimnames,name,Grid%gphiu,'double')160 CALL Write_Ncdf_var('gphiv',dimnames,name,Grid%gphiv,'double')161 CALL Write_Ncdf_var('gphif',dimnames,name,Grid%gphif,'double')162 CALL Write_Ncdf_var('e1t',dimnames,name,Grid%e1t,'double')163 CALL Write_Ncdf_var('e1u',dimnames,name,Grid%e1u,'double')164 CALL Write_Ncdf_var('e1v',dimnames,name,Grid%e1v,'double')165 CALL Write_Ncdf_var('e1f',dimnames,name,Grid%e1f,'double')166 CALL Write_Ncdf_var('e2t',dimnames,name,Grid%e2t,'double')167 CALL Write_Ncdf_var('e2u',dimnames,name,Grid%e2u,'double')168 CALL Write_Ncdf_var('e2v',dimnames,name,Grid%e2v,'double')169 CALL Write_Ncdf_var('e2f',dimnames,name,Grid%e2f,'double')170 ! 171 CALL Copy_Ncdf_att('nav_lon',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))172 CALL Copy_Ncdf_att('nav_lat',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))173 CALL Copy_Ncdf_att('glamt',TRIM(parent_coordinate_file),name)174 CALL Copy_Ncdf_att('glamu',TRIM(parent_coordinate_file),name)175 CALL Copy_Ncdf_att('glamv',TRIM(parent_coordinate_file),name)176 CALL Copy_Ncdf_att('glamf',TRIM(parent_coordinate_file),name)177 CALL Copy_Ncdf_att('gphit',TRIM(parent_coordinate_file),name)178 CALL Copy_Ncdf_att('gphiu',TRIM(parent_coordinate_file),name)179 CALL Copy_Ncdf_att('gphiv',TRIM(parent_coordinate_file),name)180 CALL Copy_Ncdf_att('gphif',TRIM(parent_coordinate_file),name)181 CALL Copy_Ncdf_att('e1t',TRIM(parent_coordinate_file),name)182 CALL Copy_Ncdf_att('e1u',TRIM(parent_coordinate_file),name)183 CALL Copy_Ncdf_att('e1v',TRIM(parent_coordinate_file),name)184 CALL Copy_Ncdf_att('e1f',TRIM(parent_coordinate_file),name)185 CALL Copy_Ncdf_att('e2t',TRIM(parent_coordinate_file),name)186 CALL Copy_Ncdf_att('e2u',TRIM(parent_coordinate_file),name)187 CALL Copy_Ncdf_att('e2v',TRIM(parent_coordinate_file),name)188 CALL Copy_Ncdf_att('e2f',TRIM(parent_coordinate_file),name)148 CALL write_ncdf_dim(dimnames(1),name,nxfin) 149 CALL write_ncdf_dim(dimnames(2),name,nyfin) 150 ! 151 CALL write_ncdf_var('nav_lon',dimnames,name,Grid%nav_lon,'float') 152 CALL write_ncdf_var('nav_lat',dimnames,name,Grid%nav_lat,'float') 153 ! 154 CALL write_ncdf_var('glamt',dimnames,name,Grid%glamt,'double') 155 CALL write_ncdf_var('glamu',dimnames,name,Grid%glamu,'double') 156 CALL write_ncdf_var('glamv',dimnames,name,Grid%glamv,'double') 157 CALL write_ncdf_var('glamf',dimnames,name,Grid%glamf,'double') 158 CALL write_ncdf_var('gphit',dimnames,name,Grid%gphit,'double') 159 CALL write_ncdf_var('gphiu',dimnames,name,Grid%gphiu,'double') 160 CALL write_ncdf_var('gphiv',dimnames,name,Grid%gphiv,'double') 161 CALL write_ncdf_var('gphif',dimnames,name,Grid%gphif,'double') 162 CALL write_ncdf_var('e1t',dimnames,name,Grid%e1t,'double') 163 CALL write_ncdf_var('e1u',dimnames,name,Grid%e1u,'double') 164 CALL write_ncdf_var('e1v',dimnames,name,Grid%e1v,'double') 165 CALL write_ncdf_var('e1f',dimnames,name,Grid%e1f,'double') 166 CALL write_ncdf_var('e2t',dimnames,name,Grid%e2t,'double') 167 CALL write_ncdf_var('e2u',dimnames,name,Grid%e2u,'double') 168 CALL write_ncdf_var('e2v',dimnames,name,Grid%e2v,'double') 169 CALL write_ncdf_var('e2f',dimnames,name,Grid%e2f,'double') 170 ! 171 CALL copy_ncdf_att('nav_lon',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon)) 172 CALL copy_ncdf_att('nav_lat',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat)) 173 CALL copy_ncdf_att('glamt',TRIM(parent_coordinate_file),name) 174 CALL copy_ncdf_att('glamu',TRIM(parent_coordinate_file),name) 175 CALL copy_ncdf_att('glamv',TRIM(parent_coordinate_file),name) 176 CALL copy_ncdf_att('glamf',TRIM(parent_coordinate_file),name) 177 CALL copy_ncdf_att('gphit',TRIM(parent_coordinate_file),name) 178 CALL copy_ncdf_att('gphiu',TRIM(parent_coordinate_file),name) 179 CALL copy_ncdf_att('gphiv',TRIM(parent_coordinate_file),name) 180 CALL copy_ncdf_att('gphif',TRIM(parent_coordinate_file),name) 181 CALL copy_ncdf_att('e1t',TRIM(parent_coordinate_file),name) 182 CALL copy_ncdf_att('e1u',TRIM(parent_coordinate_file),name) 183 CALL copy_ncdf_att('e1v',TRIM(parent_coordinate_file),name) 184 CALL copy_ncdf_att('e1f',TRIM(parent_coordinate_file),name) 185 CALL copy_ncdf_att('e2t',TRIM(parent_coordinate_file),name) 186 CALL copy_ncdf_att('e2u',TRIM(parent_coordinate_file),name) 187 CALL copy_ncdf_att('e2v',TRIM(parent_coordinate_file),name) 188 CALL copy_ncdf_att('e2f',TRIM(parent_coordinate_file),name) 189 189 ! 190 190 WRITE(*,*) ' ' … … 209 209 TYPE(Coordinates) :: Grid 210 210 ! 211 CALL Read_Ncdf_var('mbathy',name,Grid%Bathy_level)211 CALL read_ncdf_var('mbathy',name,Grid%Bathy_level) 212 212 ! 213 213 WRITE(*,*) ' ' … … 232 232 CHARACTER(len=1),DIMENSION(2) :: dimnames 233 233 ! 234 status = nf90_create(name,NF90_ NOCLOBBER,ncid)234 status = nf90_create(name,NF90_WRITE,ncid) 235 235 status = nf90_close(ncid) 236 236 ! 237 237 dimnames = (/ 'x','y' /) 238 CALL Write_Ncdf_dim(dimnames(1),name,nxfin)239 CALL Write_Ncdf_dim(dimnames(2),name,nyfin)240 ! 241 CALL Write_Ncdf_var('nav_lon',dimnames,name,Grid%nav_lon ,'float')242 CALL Write_Ncdf_var('nav_lat',dimnames,name,Grid%nav_lat ,'float')243 CALL Write_Ncdf_var('mbathy' ,dimnames,name,Grid%bathy_level,'float')244 ! 245 CALL Copy_Ncdf_att('nav_lon',TRIM(parent_meshmask_file),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))246 CALL Copy_Ncdf_att('nav_lat',TRIM(parent_meshmask_file),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))247 CALL Copy_Ncdf_att('mbathy' ,TRIM(parent_meshmask_file),name)238 CALL write_ncdf_dim(dimnames(1),name,nxfin) 239 CALL write_ncdf_dim(dimnames(2),name,nyfin) 240 ! 241 CALL write_ncdf_var('nav_lon',dimnames,name,Grid%nav_lon ,'float') 242 CALL write_ncdf_var('nav_lat',dimnames,name,Grid%nav_lat ,'float') 243 CALL write_ncdf_var('mbathy' ,dimnames,name,Grid%bathy_level,'float') 244 ! 245 CALL copy_ncdf_att('nav_lon',TRIM(parent_meshmask_file),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon)) 246 CALL copy_ncdf_att('nav_lat',TRIM(parent_meshmask_file),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat)) 247 CALL copy_ncdf_att('mbathy' ,TRIM(parent_meshmask_file),name) 248 248 ! 249 249 WRITE(*,*) ' ' … … 276 276 WRITE(*,*) ' etopo format for external high resolution database ' 277 277 WRITE(*,*) '****' 278 CALL Read_Ncdf_var('lon',name,topo_lon)279 CALL Read_Ncdf_var('lat',name,topo_lat)278 CALL read_ncdf_var('lon',name,topo_lon) 279 CALL read_ncdf_var('lat',name,topo_lat) 280 280 ELSE IF( Dims_Existence('x',name) .AND. Dims_Existence('y',name) ) THEN 281 281 WRITE(*,*) '****' 282 282 WRITE(*,*) ' OPA format for external high resolution database ' 283 283 WRITE(*,*) '****' 284 CALL Read_Ncdf_var('nav_lon',name,CoarseGrid%nav_lon)285 CALL Read_Ncdf_var('nav_lat',name,CoarseGrid%nav_lat)286 CALL Read_Ncdf_var(parent_batmet_name,name,CoarseGrid%Bathy_meter)284 CALL read_ncdf_var('nav_lon',name,CoarseGrid%nav_lon) 285 CALL read_ncdf_var('nav_lat',name,CoarseGrid%nav_lat) 286 CALL read_ncdf_var(parent_batmet_name,name,CoarseGrid%Bathy_meter) 287 287 ! 288 288 IF ( PRESENT(Pacifique) ) THEN … … 303 303 ENDIF 304 304 ! 305 IF( MAXVAL(ChildGrid%glamt) > 180 ) THEN305 IF( MAXVAL(ChildGrid%glamt) > 180. ) THEN 306 306 ! 307 WHERE( topo_lon < 0 ) 308 topo_lon = topo_lon + 360. 309 END WHERE 307 WHERE( topo_lon < 0. ) topo_lon = topo_lon + 360. 310 308 ! 311 309 i_min = MAXLOC(topo_lon,mask = topo_lon < MINVAL(ChildGrid%nav_lon)-zdel) … … 316 314 tabdim1 = ( SIZE(topo_lon) - i_min(1) + 1 ) + i_max(1) 317 315 ! 318 IF(j_min(1)-2 >= 1 .AND. j_max(1)+3 <= SIZE(topo_lat,1) ) THEN 319 j_min(1) = j_min(1)-2 320 j_max(1) = j_max(1)+3 316 IF( ln_agrif_domain ) THEN 317 IF(j_min(1)-2 >= 1 .AND. j_max(1)+3 <= SIZE(topo_lat,1) ) THEN 318 j_min(1) = j_min(1)-2 319 j_max(1) = j_max(1)+3 320 ENDIF 321 321 ENDIF 322 322 tabdim2 = j_max(1) - j_min(1) + 1 … … 352 352 ELSE 353 353 ! 354 WHERE( topo_lon > 180. ) topo_lon = topo_lon - 360. 355 ! 354 356 i_min = MAXLOC(topo_lon,mask = topo_lon < MINVAL(ChildGrid%nav_lon)-zdel) 355 357 i_max = MINLOC(topo_lon,mask = topo_lon > MAXVAL(ChildGrid%nav_lon)+zdel) … … 357 359 j_max = MINLOC(topo_lat,mask = topo_lat > MAXVAL(ChildGrid%nav_lat)+zdel) 358 360 ! 359 IF(i_min(1)-2 >= 1 .AND. i_max(1)+3 <= SIZE(topo_lon,1) ) THEN 360 i_min(1) = i_min(1)-2 361 i_max(1) = i_max(1)+3 361 IF( ln_agrif_domain ) THEN 362 IF(i_min(1)-2 >= 1 .AND. i_max(1)+3 <= SIZE(topo_lon,1) ) THEN 363 i_min(1) = i_min(1)-2 364 i_max(1) = i_max(1)+3 365 ENDIF 362 366 ENDIF 363 367 tabdim1 = i_max(1) - i_min(1) + 1 364 368 ! 365 IF(j_min(1)-2 >= 1 .AND. j_max(1)+3 <= SIZE(topo_lat,1) ) THEN 366 j_min(1) = j_min(1)-2 367 j_max(1) = j_max(1)+3 369 IF( ln_agrif_domain ) THEN 370 IF(j_min(1)-2 >= 1 .AND. j_max(1)+3 <= SIZE(topo_lat,1) ) THEN 371 j_min(1) = j_min(1)-2 372 j_max(1) = j_max(1)+3 373 ENDIF 368 374 ENDIF 369 375 tabdim2 = j_max(1) - j_min(1) + 1 … … 423 429 TYPE(Coordinates) :: Grid 424 430 ! 425 CALL Read_Ncdf_var(parent_batmet_name,name,Grid%Bathy_meter)431 CALL read_ncdf_var(parent_batmet_name,name,Grid%Bathy_meter) 426 432 ! 427 433 WRITE(*,*) ' ' … … 454 460 dimnames = (/ 'x','y' /) 455 461 456 CALL Write_Ncdf_dim(dimnames(1),name,nx)457 CALL Write_Ncdf_dim(dimnames(2),name,ny)462 CALL write_ncdf_dim(dimnames(1),name,nx) 463 CALL write_ncdf_dim(dimnames(2),name,ny) 458 464 ! 459 CALL Write_Ncdf_var('nav_lon' ,dimnames,name,Grid%nav_lon ,'float')460 CALL Write_Ncdf_var('nav_lat' ,dimnames,name,Grid%nav_lat ,'float')461 CALL Write_Ncdf_var(parent_batmet_name,dimnames,name,Grid%bathy_meter,'float')462 CALL Write_Ncdf_var('weight' ,dimnames,name,Grid%wgt ,'float')463 ! 464 CALL Copy_Ncdf_att('nav_lon' ,TRIM(parent_bathy_meter),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))465 CALL Copy_Ncdf_att('nav_lat' ,TRIM(parent_bathy_meter),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))466 CALL Copy_Ncdf_att(parent_batmet_name,TRIM(parent_bathy_meter),name)465 CALL write_ncdf_var('nav_lon' ,dimnames,name,Grid%nav_lon ,'float') 466 CALL write_ncdf_var('nav_lat' ,dimnames,name,Grid%nav_lat ,'float') 467 CALL write_ncdf_var(parent_batmet_name,dimnames,name,Grid%bathy_meter,'float') 468 CALL write_ncdf_var('weight' ,dimnames,name,Grid%wgt ,'float') 469 ! 470 CALL copy_ncdf_att('nav_lon' ,TRIM(parent_bathy_meter),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon)) 471 CALL copy_ncdf_att('nav_lat' ,TRIM(parent_bathy_meter),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat)) 472 CALL copy_ncdf_att(parent_batmet_name,TRIM(parent_bathy_meter),name) 467 473 ! 468 474 WRITE(*,*) ' ' … … 474 480 END FUNCTION Write_Bathy_meter 475 481 ! 482 !***************************************************** 483 ! function write_domcfg(name,Grid) 484 !***************************************************** 485 486 INTEGER FUNCTION write_domcfg(name,Grid) 487 !----------------------------------------- 488 ! It creates a domain_cfg.nc used in NEMO4 489 !----------------------------------------- 490 ! 491 USE io_netcdf 492 ! 493 CHARACTER(*) name 494 TYPE(Coordinates) :: Grid 495 ! 496 INTEGER :: status, ncid 497 INTEGER :: nx, ny, jk 498 INTEGER :: ln_sco, ln_isfcav, ln_zco, ln_zps, jperio 499 REAL*8 :: rpi, rad, rday, rsiyea, rsiday, omega 500 ! 501 CHARACTER(len=1), DIMENSION(3) :: dimnames 502 REAL*8 , DIMENSION(N) :: e3t_1d, e3w_1d, gdept_1d 503 REAL*8 , ALLOCATABLE, DIMENSION(:,:) :: ff_t, ff_f 504 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: bottom_level, top_level 505 REAL*8 , ALLOCATABLE, DIMENSION(:,:,:) :: e3t_0, e3u_0, e3v_0, e3f_0, e3w_0, e3uw_0, e3vw_0 506 ! 507 ! size of the Grid 508 nx = SIZE(Grid%bathy_meter,1) 509 ny = SIZE(Grid%bathy_meter,2) 510 511 ! allocate needed arrays for domain_cfg 512 ALLOCATE( ff_t(nx,ny), ff_f(nx,ny) ) 513 ALLOCATE( bottom_level(nx,ny), top_level(nx,ny) ) 514 ALLOCATE( e3t_0(nx,ny,N), e3u_0 (nx,ny,N), e3v_0 (nx,ny,N), e3f_0(nx,ny,N), & 515 & e3w_0(nx,ny,N), e3uw_0(nx,ny,N), e3vw_0(nx,ny,N) ) 516 517 ! some physical parameters 518 rpi = 3.141592653589793 519 rad = 3.141592653589793 / 180. 520 rday = 24.*60.*60. 521 rsiyea = 365.25 * rday * 2. * rpi / 6.283076 522 rsiday = rday / ( 1. + rday / rsiyea ) 523 omega = 2. * rpi / rsiday 524 525 ! Coriolis 526 ff_f(:,:) = 2. * omega * SIN( rad * Grid%gphif(:,:) ) ! compute it on the sphere at f-point 527 ff_t(:,:) = 2. * omega * SIN( rad * Grid%gphit(:,:) ) ! - - - at t-point 528 529 ! top/bottom levels 530 bottom_level(:,:) = Grid%bathy_level(:,:) 531 top_level(:,:) = MIN( 1, bottom_level(:,:) ) 532 533 ! vertical scale factors 534 CALL zgr_z( e3t_1d, e3w_1d, gdept_1d ) 535 DO jk = 1, N 536 e3t_0 (:,:,jk) = e3t_1d (jk) 537 e3u_0 (:,:,jk) = e3t_1d (jk) 538 e3v_0 (:,:,jk) = e3t_1d (jk) 539 e3f_0 (:,:,jk) = e3t_1d (jk) 540 e3w_0 (:,:,jk) = e3w_1d (jk) 541 e3uw_0 (:,:,jk) = e3w_1d (jk) 542 e3vw_0 (:,:,jk) = e3w_1d (jk) 543 END DO 544 545 ! logicals and others 546 ln_sco = 0 547 ln_isfcav = 0 548 IF( partial_steps ) THEN 549 ln_zps = 1 550 ln_zco = 0 551 ELSE 552 ln_zps = 0 553 ln_zco = 1 554 ENDIF 555 556 ! closed domain (agrif) 557 jperio = 0 558 559 ! ------------------- 560 ! write domain_cfg.nc 561 ! ------------------- 562 status = nf90_create(name,NF90_WRITE,ncid) 563 status = nf90_close(ncid) 564 ! 565 ! dimensions 566 dimnames = (/'x','y','z'/) 567 CALL write_ncdf_dim(dimnames(1),name,nx) 568 CALL write_ncdf_dim(dimnames(2),name,ny) 569 CALL write_ncdf_dim(dimnames(3),name,N) 570 ! 571 ! variables 572 CALL write_ncdf_var('nav_lon',dimnames(1:2),name,Grid%nav_lon,'float') 573 CALL write_ncdf_var('nav_lat',dimnames(1:2),name,Grid%nav_lat,'float') 574 CALL write_ncdf_var('nav_lev',dimnames(3) ,name,gdept_1d ,'float') 575 ! 576 CALL write_ncdf_var('jpiglo',name,nx ,'integer') 577 CALL write_ncdf_var('jpjglo',name,ny ,'integer') 578 CALL write_ncdf_var('jpkglo',name,N ,'integer') 579 CALL write_ncdf_var('jperio',name,jperio,'integer') 580 ! 581 CALL write_ncdf_var('ln_zco' ,name,ln_zco ,'integer') 582 CALL write_ncdf_var('ln_zps' ,name,ln_zps ,'integer') 583 CALL write_ncdf_var('ln_sco' ,name,ln_sco ,'integer') 584 CALL write_ncdf_var('ln_isfcav',name,ln_isfcav,'integer') 585 586 CALL write_ncdf_var('glamt',dimnames(1:2),name,Grid%glamt,'double') 587 CALL write_ncdf_var('glamu',dimnames(1:2),name,Grid%glamu,'double') 588 CALL write_ncdf_var('glamv',dimnames(1:2),name,Grid%glamv,'double') 589 CALL write_ncdf_var('glamf',dimnames(1:2),name,Grid%glamf,'double') 590 CALL write_ncdf_var('gphit',dimnames(1:2),name,Grid%gphit,'double') 591 CALL write_ncdf_var('gphiu',dimnames(1:2),name,Grid%gphiu,'double') 592 CALL write_ncdf_var('gphiv',dimnames(1:2),name,Grid%gphiv,'double') 593 CALL write_ncdf_var('gphif',dimnames(1:2),name,Grid%gphif,'double') 594 595 CALL write_ncdf_var('e1t',dimnames(1:2),name,Grid%e1t,'double') 596 CALL write_ncdf_var('e1u',dimnames(1:2),name,Grid%e1u,'double') 597 CALL write_ncdf_var('e1v',dimnames(1:2),name,Grid%e1v,'double') 598 CALL write_ncdf_var('e1f',dimnames(1:2),name,Grid%e1f,'double') 599 CALL write_ncdf_var('e2t',dimnames(1:2),name,Grid%e2t,'double') 600 CALL write_ncdf_var('e2u',dimnames(1:2),name,Grid%e2u,'double') 601 CALL write_ncdf_var('e2v',dimnames(1:2),name,Grid%e2v,'double') 602 CALL write_ncdf_var('e2f',dimnames(1:2),name,Grid%e2f,'double') 603 604 CALL write_ncdf_var('ff_f',dimnames(1:2),name,ff_f,'double') 605 CALL write_ncdf_var('ff_t',dimnames(1:2),name,ff_t,'double') 606 607 CALL write_ncdf_var('e3t_1d',dimnames(3),name,e3t_1d,'double') 608 CALL write_ncdf_var('e3w_1d',dimnames(3),name,e3w_1d,'double') 609 610 CALL write_ncdf_var('e3t_0' ,dimnames(:),name,e3t_0 ,'double') 611 CALL write_ncdf_var('e3w_0' ,dimnames(:),name,e3w_0 ,'double') 612 CALL write_ncdf_var('e3u_0' ,dimnames(:),name,e3u_0 ,'double') 613 CALL write_ncdf_var('e3v_0' ,dimnames(:),name,e3v_0 ,'double') 614 CALL write_ncdf_var('e3f_0' ,dimnames(:),name,e3f_0 ,'double') 615 CALL write_ncdf_var('e3w_0' ,dimnames(:),name,e3w_0 ,'double') 616 CALL write_ncdf_var('e3uw_0',dimnames(:),name,e3uw_0,'double') 617 CALL write_ncdf_var('e3vw_0',dimnames(:),name,e3vw_0,'double') 618 619 CALL write_ncdf_var('bottom_level',dimnames(1:2),name,bottom_level,'integer') 620 CALL write_ncdf_var('top_level' ,dimnames(1:2),name,top_level ,'integer') 621 622 CALL write_ncdf_var('bathy_meter' ,dimnames(1:2),name,Grid%bathy_meter,'float') 623 624 ! some attributes 625 CALL copy_ncdf_att('nav_lon',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon)) 626 CALL copy_ncdf_att('nav_lat',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat)) 627 628 CALL copy_ncdf_att('glamt',TRIM(parent_coordinate_file),name) 629 CALL copy_ncdf_att('glamu',TRIM(parent_coordinate_file),name) 630 CALL copy_ncdf_att('glamv',TRIM(parent_coordinate_file),name) 631 CALL copy_ncdf_att('glamf',TRIM(parent_coordinate_file),name) 632 CALL copy_ncdf_att('gphit',TRIM(parent_coordinate_file),name) 633 CALL copy_ncdf_att('gphiu',TRIM(parent_coordinate_file),name) 634 CALL copy_ncdf_att('gphiv',TRIM(parent_coordinate_file),name) 635 CALL copy_ncdf_att('gphif',TRIM(parent_coordinate_file),name) 636 637 CALL copy_ncdf_att('e1t',TRIM(parent_coordinate_file),name) 638 CALL copy_ncdf_att('e1u',TRIM(parent_coordinate_file),name) 639 CALL copy_ncdf_att('e1v',TRIM(parent_coordinate_file),name) 640 CALL copy_ncdf_att('e1f',TRIM(parent_coordinate_file),name) 641 CALL copy_ncdf_att('e2t',TRIM(parent_coordinate_file),name) 642 CALL copy_ncdf_att('e2u',TRIM(parent_coordinate_file),name) 643 CALL copy_ncdf_att('e2v',TRIM(parent_coordinate_file),name) 644 CALL copy_ncdf_att('e2f',TRIM(parent_coordinate_file),name) 645 ! 646 ! control print 647 WRITE(*,*) ' ' 648 WRITE(*,*) 'Writing domcfg file: ',name 649 WRITE(*,*) ' ' 650 ! 651 DEALLOCATE( ff_t, ff_f ) 652 DEALLOCATE( bottom_level, top_level ) 653 DEALLOCATE( e3t_0, e3u_0, e3v_0, e3f_0, e3w_0, e3uw_0, e3vw_0 ) 654 ! 655 write_domcfg = 1 656 657 END FUNCTION write_domcfg 658 ! 659 SUBROUTINE zgr_z(e3t_1d, e3w_1d, gdept_1d) 660 !!---------------------------------------------------------------------- 661 !! *** ROUTINE zgr_z (from NEMO4) *** 662 !! 663 !! ** Purpose : set the depth of model levels and the resulting 664 !! vertical scale factors. 665 !! 666 !! ** Method : z-coordinate system (use in all type of coordinate) 667 !! The depth of model levels is defined from an analytical 668 !! function the derivative of which gives the scale factors. 669 !! both depth and scale factors only depend on k (1d arrays). 670 !! w-level: gdepw_1d = gdep(k) 671 !! e3w_1d(k) = dk(gdep)(k) = e3(k) 672 !! t-level: gdept_1d = gdep(k+0.5) 673 !! e3t_1d(k) = dk(gdep)(k+0.5) = e3(k+0.5) 674 !! 675 !! ** Action : - gdept_1d, gdepw_1d : depth of T- and W-point (m) 676 !! - e3t_1d , e3w_1d : scale factors at T- and W-levels (m) 677 !! 678 !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766. 679 !!---------------------------------------------------------------------- 680 INTEGER :: jk ! dummy loop indices 681 INTEGER :: jpk 682 REAL*8 :: zt, zw ! temporary scalars 683 REAL*8 :: zsur, za0, za1, zkth ! Values set from parameters in 684 REAL*8 :: zacr, zdzmin, zhmax ! par_CONFIG_Rxx.h90 685 REAL*8 :: za2, zkth2, zacr2 ! Values for optional double tanh function set from parameters 686 687 REAL*8, DIMENSION(:), INTENT(inout) :: e3t_1d, e3w_1d, gdept_1d 688 REAL*8, DIMENSION(N) :: gdepw_1d 689 !!---------------------------------------------------------------------- 690 ! 691 ! 692 ! Set variables from parameters 693 ! ------------------------------ 694 zkth = ppkth ; zacr = ppacr 695 zdzmin = ppdzmin ; zhmax = pphmax 696 zkth2 = ppkth2 ; zacr2 = ppacr2 ! optional (ldbletanh=T) double tanh parameters 697 698 ! If pa1 and pa0 and psur are et to pp_to_be_computed 699 ! za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr 700 IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) & 701 .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 702 ! 703 za1 = ( ppdzmin - pphmax / FLOAT(N-1) ) & 704 & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(N-1) * ( LOG( COSH( (N - ppkth) / ppacr) ) & 705 & - LOG( COSH( ( 1 - ppkth) / ppacr) ) ) ) 706 za0 = ppdzmin - za1 * TANH( (1-ppkth) / ppacr ) 707 zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr ) ) 708 ELSE 709 za1 = pa1 ; za0 = pa0 ; zsur = psur 710 za2 = pa2 ! optional (ldbletanh=T) double tanh parameter 711 ENDIF 712 713 ! Reference z-coordinate (depth - scale factor at T- and W-points) 714 ! ====================== 715 IF( ppkth == 0. ) THEN ! uniform vertical grid 716 717 za1 = zhmax / FLOAT(N-1) 718 719 DO jk = 1, N 720 zw = FLOAT( jk ) 721 zt = FLOAT( jk ) + 0.5 722 gdepw_1d(jk) = ( zw - 1 ) * za1 723 gdept_1d(jk) = ( zt - 1 ) * za1 724 e3w_1d (jk) = za1 725 e3t_1d (jk) = za1 726 END DO 727 ELSE ! Madec & Imbard 1996 function 728 IF( .NOT. ldbletanh ) THEN 729 DO jk = 1, N 730 zw = REAL( jk ) 731 zt = REAL( jk ) + 0.5 732 gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) ) ) 733 gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) ) ) 734 e3w_1d (jk) = za0 + za1 * TANH( (zw-zkth) / zacr ) 735 e3t_1d (jk) = za0 + za1 * TANH( (zt-zkth) / zacr ) 736 END DO 737 ELSE 738 DO jk = 1, N 739 zw = FLOAT( jk ) 740 zt = FLOAT( jk ) + 0.5 741 ! Double tanh function 742 gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr ) ) & 743 & + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) ) ) 744 gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr ) ) & 745 & + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) ) ) 746 e3w_1d (jk) = za0 + za1 * TANH( (zw-zkth ) / zacr ) & 747 & + za2 * TANH( (zw-zkth2) / zacr2 ) 748 e3t_1d (jk) = za0 + za1 * TANH( (zt-zkth ) / zacr ) & 749 & + za2 * TANH( (zt-zkth2) / zacr2 ) 750 END DO 751 ENDIF 752 gdepw_1d(1) = 0. ! force first w-level to be exactly at zero 753 ENDIF 754 755 IF ( ln_e3_dep ) THEN ! e3. = dk[gdep] 756 ! 757 !==>>> need to be like this to compute the pressure gradient with ISF. 758 ! If not, level beneath the ISF are not aligned (sum(e3t) /= depth) 759 ! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively 760 ! 761 DO jk = 1, N-1 762 e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk) 763 END DO 764 e3t_1d(N) = e3t_1d(N-1) ! we don't care because this level is masked in NEMO 765 766 DO jk = 2, N 767 e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1) 768 END DO 769 e3w_1d(1 ) = 2. * (gdept_1d(1) - gdepw_1d(1)) 770 END IF 771 772 ! 773 END SUBROUTINE zgr_z 774 775 476 776 !***************************************************** 477 777 ! function set_child_name(Parentname,Childname) … … 501 801 ! 502 802 END SUBROUTINE set_child_name 503 !504 !*****************************************************505 ! function set_child_name(Parentname,Childname)506 !*****************************************************507 803 ! 508 804 !***************************************************** … … 558 854 END SUBROUTINE get_interptype 559 855 ! 560 !*****************************************************561 ! end subroutine get_interptype562 !*****************************************************563 !564 856 !***************************************************** 565 857 ! subroutine Init_mask(name,Grid) … … 576 868 ! 577 869 IF(jpiglo == 1 .AND. jpjglo == 1) THEN 578 CALL Read_Ncdf_var('Bathy_level',name,Grid%Bathy_level)870 CALL read_ncdf_var('Bathy_level',name,Grid%Bathy_level) 579 871 ELSE 580 CALL Read_Ncdf_var('Bathy_level',name,Grid%Bathy_level,(/jpizoom,jpjzoom/),(/jpiglo,jpjglo/) )872 CALL read_ncdf_var('Bathy_level',name,Grid%Bathy_level,(/jpizoom,jpjzoom/),(/jpiglo,jpjglo/) ) 581 873 ENDIF 582 874 … … 655 947 ! 656 948 !***************************************************** 657 ! end subroutine Init_mask658 !*****************************************************659 !660 !*****************************************************661 949 ! subroutine Init_Tmask(name,Grid) 662 950 !***************************************************** … … 672 960 ! 673 961 IF(jpiglo == 1 .AND. jpjglo == 1) THEN 674 CALL Read_Ncdf_var('Bathy_level',name,Grid%Bathy_level)962 CALL read_ncdf_var('Bathy_level',name,Grid%Bathy_level) 675 963 ELSE 676 CALL Read_Ncdf_var('Bathy_level',name,Grid%Bathy_level,(/jpizoom,jpjzoom/),(/jpiglo,jpjglo/) )964 CALL read_ncdf_var('Bathy_level',name,Grid%Bathy_level,(/jpizoom,jpjzoom/),(/jpiglo,jpjglo/) ) 677 965 ENDIF 678 966 ! … … 712 1000 TYPE(Coordinates) :: Grid 713 1001 ! 714 CALL Read_Ncdf_var('Bathy_level',filename,Grid%Bathy_level)1002 CALL read_ncdf_var('Bathy_level',filename,Grid%Bathy_level) 715 1003 ! 716 1004 nx = SIZE(Grid%Bathy_level,1) … … 764 1052 END SUBROUTINE get_mask 765 1053 ! 766 !*****************************************************767 ! end subroutine get_mask768 !*****************************************************769 !770 1054 ! 771 1055 !***************************************************** … … 803 1087 ! 804 1088 END SUBROUTINE write_dimg_var 805 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 806 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1089 807 1090 END MODULE agrif_readwrite
Note: See TracChangeset
for help on using the changeset viewer.
