agrif_readwrite.f90 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794
  1. !************************************************************************
  2. ! Fortran 95 OPA Nesting tools *
  3. ! *
  4. ! Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr) *
  5. ! *
  6. !************************************************************************
  7. !
  8. MODULE agrif_readwrite
  9. !
  10. USE agrif_types
  11. !
  12. IMPLICIT NONE
  13. !
  14. CONTAINS
  15. !
  16. !************************************************************************
  17. ! *
  18. ! MODULE AGRIF_READWRITE *
  19. ! *
  20. ! module containing subroutine used for : *
  21. ! - Coordinates files reading/writing *
  22. ! - Bathymetry files reading/writing (meter and levels) *
  23. ! - Naming of child grid files *
  24. ! *
  25. !************************************************************************
  26. !
  27. !*****************************************************
  28. ! function Read_Coordinates(name,Grid)
  29. !*****************************************************
  30. INTEGER FUNCTION Read_Coordinates(name,Grid,Pacifique)
  31. !
  32. USE io_netcdf
  33. !
  34. ! file name to open
  35. !
  36. CHARACTER(*) name
  37. LOGICAL,OPTIONAL :: Pacifique
  38. !
  39. TYPE(Coordinates) :: Grid
  40. !
  41. CALL Read_Ncdf_var('glamt',name,Grid%glamt)
  42. CALL Read_Ncdf_var('glamu',name,Grid%glamu)
  43. CALL Read_Ncdf_var('glamv',name,Grid%glamv)
  44. CALL Read_Ncdf_var('glamf',name,Grid%glamf)
  45. CALL Read_Ncdf_var('gphit',name,Grid%gphit)
  46. CALL Read_Ncdf_var('gphiu',name,Grid%gphiu)
  47. CALL Read_Ncdf_var('gphiv',name,Grid%gphiv)
  48. CALL Read_Ncdf_var('gphif',name,Grid%gphif)
  49. CALL Read_Ncdf_var('e1t',name,Grid%e1t)
  50. CALL Read_Ncdf_var('e1u',name,Grid%e1u)
  51. CALL Read_Ncdf_var('e1v',name,Grid%e1v)
  52. CALL Read_Ncdf_var('e1f',name,Grid%e1f)
  53. CALL Read_Ncdf_var('e2t',name,Grid%e2t)
  54. CALL Read_Ncdf_var('e2u',name,Grid%e2u)
  55. CALL Read_Ncdf_var('e2v',name,Grid%e2v)
  56. CALL Read_Ncdf_var('e2f',name,Grid%e2f)
  57. CALL Read_Ncdf_var('nav_lon',name,Grid%nav_lon)
  58. CALL Read_Ncdf_var('nav_lat',name,Grid%nav_lat)
  59. !
  60. IF( PRESENT(Pacifique) )THEN
  61. IF ( Grid%glamt(1,1) > Grid%glamt(nxfin,nyfin) ) THEN
  62. Pacifique = .TRUE.
  63. WHERE ( Grid%glamt < 0 )
  64. Grid%glamt = Grid%glamt + 360.
  65. END WHERE
  66. WHERE ( Grid%glamf < 0 )
  67. Grid%glamf = Grid%glamf + 360.
  68. END WHERE
  69. WHERE ( Grid%glamu < 0 )
  70. Grid%glamu = Grid%glamu + 360.
  71. END WHERE
  72. WHERE ( Grid%glamv < 0 )
  73. Grid%glamv = Grid%glamv + 360.
  74. END WHERE
  75. WHERE ( Grid%nav_lon < 0 )
  76. Grid%nav_lon = Grid%nav_lon + 360.
  77. END WHERE
  78. ENDIF
  79. ENDIF
  80. !
  81. WRITE(*,*) ' '
  82. WRITE(*,*) 'Reading coordinates file: ',name
  83. WRITE(*,*) ' '
  84. !
  85. Read_Coordinates = 1
  86. !
  87. END FUNCTION Read_Coordinates
  88. !*****************************************************
  89. ! function Read_Coordinates(name,Grid)
  90. !*****************************************************
  91. INTEGER FUNCTION Read_Local_Coordinates(name,Grid,strt,cnt)
  92. !
  93. USE io_netcdf
  94. !
  95. ! file name to open
  96. !
  97. CHARACTER(*) name
  98. INTEGER, DIMENSION(2) :: strt,cnt
  99. !
  100. TYPE(Coordinates) :: Grid
  101. !
  102. CALL Read_Ncdf_var('glamt',name,Grid%glamt,strt,cnt)
  103. CALL Read_Ncdf_var('glamu',name,Grid%glamu,strt,cnt)
  104. CALL Read_Ncdf_var('glamv',name,Grid%glamv,strt,cnt)
  105. CALL Read_Ncdf_var('glamf',name,Grid%glamf,strt,cnt)
  106. CALL Read_Ncdf_var('gphit',name,Grid%gphit,strt,cnt)
  107. CALL Read_Ncdf_var('gphiu',name,Grid%gphiu,strt,cnt)
  108. CALL Read_Ncdf_var('gphiv',name,Grid%gphiv,strt,cnt)
  109. CALL Read_Ncdf_var('gphif',name,Grid%gphif,strt,cnt)
  110. CALL Read_Ncdf_var('e1t',name,Grid%e1t,strt,cnt)
  111. CALL Read_Ncdf_var('e1u',name,Grid%e1u,strt,cnt)
  112. CALL Read_Ncdf_var('e1v',name,Grid%e1v,strt,cnt)
  113. CALL Read_Ncdf_var('e1f',name,Grid%e1f,strt,cnt)
  114. CALL Read_Ncdf_var('e2t',name,Grid%e2t,strt,cnt)
  115. CALL Read_Ncdf_var('e2u',name,Grid%e2u,strt,cnt)
  116. CALL Read_Ncdf_var('e2v',name,Grid%e2v,strt,cnt)
  117. CALL Read_Ncdf_var('e2f',name,Grid%e2f,strt,cnt)
  118. CALL Read_Ncdf_var('nav_lon',name,Grid%nav_lon,strt,cnt)
  119. CALL Read_Ncdf_var('nav_lat',name,Grid%nav_lat,strt,cnt)
  120. !
  121. WRITE(*,*) ' '
  122. WRITE(*,*) 'Reading coordinates file: ',name
  123. WRITE(*,*) ' '
  124. !
  125. Read_Local_Coordinates = 1
  126. !
  127. END FUNCTION Read_Local_Coordinates
  128. !*****************************************************
  129. ! function Write_Coordinates(name,Grid)
  130. !*****************************************************
  131. INTEGER FUNCTION Write_Coordinates(name,Grid)
  132. !
  133. USE io_netcdf
  134. CHARACTER(*) name
  135. TYPE(Coordinates) :: Grid
  136. INTEGER :: status,ncid
  137. CHARACTER(len=1),DIMENSION(2) :: dimnames
  138. !
  139. status = nf90_create(name,NF90_WRITE,ncid)
  140. status = nf90_close(ncid)
  141. !
  142. dimnames = (/ 'x','y' /)
  143. CALL Write_Ncdf_dim(dimnames(1),name,nxfin)
  144. CALL Write_Ncdf_dim(dimnames(2),name,nyfin)
  145. !
  146. CALL Write_Ncdf_var('nav_lon',dimnames,name,Grid%nav_lon,'float')
  147. CALL Write_Ncdf_var('nav_lat',dimnames,name,Grid%nav_lat,'float')
  148. !
  149. CALL Write_Ncdf_var('glamt',dimnames,name,Grid%glamt,'double')
  150. CALL Write_Ncdf_var('glamu',dimnames,name,Grid%glamu,'double')
  151. CALL Write_Ncdf_var('glamv',dimnames,name,Grid%glamv,'double')
  152. CALL Write_Ncdf_var('glamf',dimnames,name,Grid%glamf,'double')
  153. CALL Write_Ncdf_var('gphit',dimnames,name,Grid%gphit,'double')
  154. CALL Write_Ncdf_var('gphiu',dimnames,name,Grid%gphiu,'double')
  155. CALL Write_Ncdf_var('gphiv',dimnames,name,Grid%gphiv,'double')
  156. CALL Write_Ncdf_var('gphif',dimnames,name,Grid%gphif,'double')
  157. CALL Write_Ncdf_var('e1t',dimnames,name,Grid%e1t,'double')
  158. CALL Write_Ncdf_var('e1u',dimnames,name,Grid%e1u,'double')
  159. CALL Write_Ncdf_var('e1v',dimnames,name,Grid%e1v,'double')
  160. CALL Write_Ncdf_var('e1f',dimnames,name,Grid%e1f,'double')
  161. CALL Write_Ncdf_var('e2t',dimnames,name,Grid%e2t,'double')
  162. CALL Write_Ncdf_var('e2u',dimnames,name,Grid%e2u,'double')
  163. CALL Write_Ncdf_var('e2v',dimnames,name,Grid%e2v,'double')
  164. CALL Write_Ncdf_var('e2f',dimnames,name,Grid%e2f,'double')
  165. !
  166. CALL Copy_Ncdf_att('nav_lon',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))
  167. CALL Copy_Ncdf_att('nav_lat',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))
  168. CALL Copy_Ncdf_att('glamt',TRIM(parent_coordinate_file),name)
  169. CALL Copy_Ncdf_att('glamu',TRIM(parent_coordinate_file),name)
  170. CALL Copy_Ncdf_att('glamv',TRIM(parent_coordinate_file),name)
  171. CALL Copy_Ncdf_att('glamf',TRIM(parent_coordinate_file),name)
  172. CALL Copy_Ncdf_att('gphit',TRIM(parent_coordinate_file),name)
  173. CALL Copy_Ncdf_att('gphiu',TRIM(parent_coordinate_file),name)
  174. CALL Copy_Ncdf_att('gphiv',TRIM(parent_coordinate_file),name)
  175. CALL Copy_Ncdf_att('gphif',TRIM(parent_coordinate_file),name)
  176. CALL Copy_Ncdf_att('e1t',TRIM(parent_coordinate_file),name)
  177. CALL Copy_Ncdf_att('e1u',TRIM(parent_coordinate_file),name)
  178. CALL Copy_Ncdf_att('e1v',TRIM(parent_coordinate_file),name)
  179. CALL Copy_Ncdf_att('e1f',TRIM(parent_coordinate_file),name)
  180. CALL Copy_Ncdf_att('e2t',TRIM(parent_coordinate_file),name)
  181. CALL Copy_Ncdf_att('e2u',TRIM(parent_coordinate_file),name)
  182. CALL Copy_Ncdf_att('e2v',TRIM(parent_coordinate_file),name)
  183. CALL Copy_Ncdf_att('e2f',TRIM(parent_coordinate_file),name)
  184. !
  185. WRITE(*,*) ' '
  186. WRITE(*,*) 'Writing coordinates file: ',name
  187. WRITE(*,*) ' '
  188. !
  189. Write_Coordinates = 1
  190. !
  191. END FUNCTION Write_Coordinates
  192. !
  193. !
  194. !
  195. !*****************************************************
  196. ! function Read_Bathy_level(name,Grid)
  197. !*****************************************************
  198. !
  199. INTEGER FUNCTION Read_Bathy_level(name,Grid)
  200. !
  201. USE io_netcdf
  202. !
  203. CHARACTER(*) name
  204. TYPE(Coordinates) :: Grid
  205. !
  206. CALL Read_Ncdf_var('mbathy',name,Grid%Bathy_level)
  207. !
  208. WRITE(*,*) ' '
  209. WRITE(*,*) 'Reading bathymetry file: ',name
  210. WRITE(*,*) ' '
  211. !
  212. Read_Bathy_level = 1
  213. !
  214. END FUNCTION Read_Bathy_level
  215. !
  216. !*****************************************************
  217. ! function Write_Bathy_level(name,Grid)
  218. !*****************************************************
  219. !
  220. INTEGER FUNCTION Write_Bathy_level(name,Grid)
  221. !
  222. USE io_netcdf
  223. !
  224. CHARACTER(*) name
  225. TYPE(Coordinates) :: Grid
  226. INTEGER :: status,ncid
  227. CHARACTER(len=1),DIMENSION(2) :: dimnames
  228. !
  229. status = nf90_create(name,NF90_NOCLOBBER,ncid)
  230. status = nf90_close(ncid)
  231. !
  232. dimnames = (/ 'x','y' /)
  233. CALL Write_Ncdf_dim(dimnames(1),name,nxfin)
  234. CALL Write_Ncdf_dim(dimnames(2),name,nyfin)
  235. !
  236. CALL Write_Ncdf_var('nav_lon',dimnames,name,Grid%nav_lon ,'float')
  237. CALL Write_Ncdf_var('nav_lat',dimnames,name,Grid%nav_lat ,'float')
  238. CALL Write_Ncdf_var('mbathy' ,dimnames,name,Grid%bathy_level,'float')
  239. !
  240. CALL Copy_Ncdf_att('nav_lon',TRIM(parent_meshmask_file),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))
  241. CALL Copy_Ncdf_att('nav_lat',TRIM(parent_meshmask_file),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))
  242. CALL Copy_Ncdf_att('mbathy' ,TRIM(parent_meshmask_file),name)
  243. !
  244. WRITE(*,*) ' '
  245. WRITE(*,*) 'Writing bathymetry file: ',name
  246. WRITE(*,*) ' '
  247. !
  248. Write_Bathy_level = 1
  249. !
  250. END FUNCTION Write_Bathy_level
  251. !
  252. !*****************************************************
  253. ! function Read_Bathy_meter(name,CoarseGrid,ChildGrid)
  254. !*****************************************************
  255. !
  256. INTEGER FUNCTION Read_Bathy_meter(name,CoarseGrid,ChildGrid,Pacifique)
  257. !
  258. USE io_netcdf
  259. CHARACTER(*) name
  260. INTEGER :: i,j,tabdim1,tabdim2
  261. INTEGER, DIMENSION(1) :: i_min,i_max,j_min,j_max
  262. REAL*8,POINTER,DIMENSION(:) :: topo_lon,topo_lat
  263. INTEGER :: status,ncid,varid
  264. LOGICAL,OPTIONAL :: Pacifique
  265. TYPE(Coordinates) :: CoarseGrid,ChildGrid
  266. !
  267. IF( Dims_Existence('lon',name) .AND. Dims_Existence('lat',name) ) THEN
  268. WRITE(*,*) '****'
  269. WRITE(*,*) ' etopo format for external high resolution database '
  270. WRITE(*,*) '****'
  271. CALL Read_Ncdf_var('lon',name,topo_lon)
  272. CALL Read_Ncdf_var('lat',name,topo_lat)
  273. ELSE IF( Dims_Existence('x',name) .AND. Dims_Existence('y',name) ) THEN
  274. WRITE(*,*) '****'
  275. WRITE(*,*) ' OPA format for external high resolution database '
  276. WRITE(*,*) '****'
  277. CALL Read_Ncdf_var('nav_lon',name,CoarseGrid%nav_lon)
  278. CALL Read_Ncdf_var('nav_lat',name,CoarseGrid%nav_lat)
  279. CALL Read_Ncdf_var(parent_batmet_name,name,CoarseGrid%Bathy_meter)
  280. !
  281. IF ( PRESENT(Pacifique) ) THEN
  282. IF(Pacifique) THEN
  283. WHERE(CoarseGrid%nav_lon < 0.001)
  284. CoarseGrid%nav_lon = CoarseGrid%nav_lon + 360.
  285. END WHERE
  286. ENDIF
  287. ENDIF
  288. !
  289. Read_Bathy_meter = 1
  290. RETURN
  291. ELSE
  292. WRITE(*,*) '****'
  293. WRITE(*,*) '*** ERROR Bad format for external high resolution database'
  294. WRITE(*,*) '****'
  295. STOP
  296. ENDIF
  297. !
  298. IF( MAXVAL(ChildGrid%glamt) > 180 ) THEN
  299. !
  300. WHERE( topo_lon < 0 )
  301. topo_lon = topo_lon + 360.
  302. END WHERE
  303. !
  304. i_min = MAXLOC(topo_lon,mask = topo_lon < MINVAL(ChildGrid%nav_lon))
  305. i_max = MINLOC(topo_lon,mask = topo_lon > MAXVAL(ChildGrid%nav_lon))
  306. j_min = MAXLOC(topo_lat,mask = topo_lat < MINVAL(ChildGrid%nav_lat))
  307. j_max = MINLOC(topo_lat,mask = topo_lat > MAXVAL(ChildGrid%nav_lat))
  308. !
  309. tabdim1 = ( SIZE(topo_lon) - i_min(1) + 1 ) + i_max(1)
  310. !
  311. IF(j_min(1)-2 >= 1 .AND. j_max(1)+3 <= SIZE(topo_lat,1) ) THEN
  312. j_min(1) = j_min(1)-2
  313. j_max(1) = j_max(1)+3
  314. ENDIF
  315. tabdim2 = j_max(1) - j_min(1) + 1
  316. !
  317. ALLOCATE(CoarseGrid%nav_lon(tabdim1,tabdim2))
  318. ALLOCATE(CoarseGrid%nav_lat(tabdim1,tabdim2))
  319. ALLOCATE(CoarseGrid%Bathy_meter(tabdim1,tabdim2))
  320. !
  321. DO i = 1,tabdim1
  322. CoarseGrid%nav_lat(i,:) = topo_lat(j_min(1):j_max(1))
  323. END DO
  324. !
  325. DO j = 1, tabdim2
  326. !
  327. CoarseGrid%nav_lon(1:SIZE(topo_lon)-i_min(1)+1 ,j) = topo_lon(i_min(1):SIZE(topo_lon))
  328. CoarseGrid%nav_lon(2+SIZE(topo_lon)-i_min(1):tabdim1,j) = topo_lon(1:i_max(1))
  329. !
  330. END DO
  331. status = nf90_open(name,NF90_NOWRITE,ncid)
  332. status = nf90_inq_varid(ncid,elevation_name,varid)
  333. !
  334. status=nf90_get_var(ncid,varid,CoarseGrid%Bathy_meter(1:SIZE(topo_lon)-i_min(1)+1,:), &
  335. start=(/i_min(1),j_min(1)/),count=(/SIZE(topo_lon)-i_min(1),tabdim2/))
  336. status=nf90_get_var(ncid,varid,CoarseGrid%Bathy_meter(2+SIZE(topo_lon)-i_min(1):tabdim1,:), &
  337. start=(/1,j_min(1)/),count=(/i_max(1),tabdim2/))
  338. !
  339. ELSE
  340. !
  341. i_min = MAXLOC(topo_lon,mask = topo_lon < MINVAL(ChildGrid%nav_lon))
  342. i_max = MINLOC(topo_lon,mask = topo_lon > MAXVAL(ChildGrid%nav_lon))
  343. j_min = MAXLOC(topo_lat,mask = topo_lat < MINVAL(ChildGrid%nav_lat))
  344. j_max = MINLOC(topo_lat,mask = topo_lat > MAXVAL(ChildGrid%nav_lat))
  345. !
  346. IF(i_min(1)-2 >= 1 .AND. i_max(1)+3 <= SIZE(topo_lon,1) ) THEN
  347. i_min(1) = i_min(1)-2
  348. i_max(1) = i_max(1)+3
  349. ENDIF
  350. tabdim1 = i_max(1) - i_min(1) + 1
  351. !
  352. IF(j_min(1)-2 >= 1 .AND. j_max(1)+3 <= SIZE(topo_lat,1) ) THEN
  353. j_min(1) = j_min(1)-2
  354. j_max(1) = j_max(1)+3
  355. ENDIF
  356. tabdim2 = j_max(1) - j_min(1) + 1
  357. !
  358. WRITE(*,*) ' '
  359. WRITE(*,*) 'Reading bathymetry file: ',name
  360. WRITE(*,*) ' '
  361. !
  362. ALLOCATE(CoarseGrid%nav_lon(tabdim1,tabdim2))
  363. ALLOCATE(CoarseGrid%nav_lat(tabdim1,tabdim2))
  364. ALLOCATE(CoarseGrid%Bathy_meter(tabdim1,tabdim2))
  365. !
  366. DO j = 1,tabdim2
  367. CoarseGrid%nav_lon(:,j) = topo_lon(i_min(1):i_max(1))
  368. END DO
  369. !
  370. DO i = 1,tabdim1
  371. CoarseGrid%nav_lat(i,:) = topo_lat(j_min(1):j_max(1))
  372. END DO
  373. !
  374. status = nf90_open(name,NF90_NOWRITE,ncid)
  375. status = nf90_inq_varid(ncid,elevation_name,varid)
  376. status = nf90_get_var(ncid,varid,CoarseGrid%Bathy_meter, &
  377. & start=(/i_min(1),j_min(1)/),count=(/tabdim1,tabdim2/))
  378. !
  379. ENDIF
  380. !
  381. status = nf90_close(ncid)
  382. !
  383. WHERE(CoarseGrid%Bathy_meter.GE.0)
  384. CoarseGrid%Bathy_meter = 0.0
  385. END WHERE
  386. !
  387. CoarseGrid%Bathy_meter(:,:) = -1.0 * CoarseGrid%Bathy_meter(:,:)
  388. !
  389. Read_Bathy_meter = 1
  390. RETURN
  391. !
  392. END FUNCTION Read_Bathy_meter
  393. !
  394. !
  395. !*****************************************************
  396. ! function Read_Bathy_meter(name,CoarseGrid,ChildGrid)
  397. !*****************************************************
  398. !
  399. INTEGER FUNCTION Read_Bathymeter(name,Grid)
  400. !
  401. !
  402. USE io_netcdf
  403. !
  404. CHARACTER(*) name
  405. TYPE(Coordinates) :: Grid
  406. !
  407. CALL Read_Ncdf_var(parent_batmet_name,name,Grid%Bathy_meter)
  408. !
  409. WRITE(*,*) ' '
  410. WRITE(*,*) 'Reading bathymetry file: ',name
  411. WRITE(*,*) ' '
  412. !
  413. Read_Bathymeter = 1
  414. !
  415. END FUNCTION Read_Bathymeter
  416. !
  417. !*****************************************************
  418. ! function Write_Bathy_meter(name,Grid)
  419. !*****************************************************
  420. !
  421. INTEGER FUNCTION Write_Bathy_meter(name,Grid)
  422. !
  423. USE io_netcdf
  424. !
  425. CHARACTER(*) name
  426. TYPE(Coordinates) :: Grid
  427. INTEGER :: status,ncid
  428. CHARACTER(len=1),DIMENSION(2) :: dimnames
  429. INTEGER :: nx,ny
  430. !
  431. status = nf90_create(name,NF90_WRITE,ncid)
  432. status = nf90_close(ncid)
  433. !
  434. nx = SIZE(Grid%bathy_meter,1)
  435. ny = SIZE(Grid%bathy_meter,2)
  436. dimnames = (/ 'x','y' /)
  437. CALL Write_Ncdf_dim(dimnames(1),name,nx)
  438. CALL Write_Ncdf_dim(dimnames(2),name,ny)
  439. !
  440. CALL Write_Ncdf_var('nav_lon' ,dimnames,name,Grid%nav_lon ,'float')
  441. CALL Write_Ncdf_var('nav_lat' ,dimnames,name,Grid%nav_lat ,'float')
  442. CALL Write_Ncdf_var(parent_batmet_name,dimnames,name,Grid%bathy_meter,'float')
  443. !
  444. CALL Copy_Ncdf_att('nav_lon' ,TRIM(parent_bathy_meter),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))
  445. CALL Copy_Ncdf_att('nav_lat' ,TRIM(parent_bathy_meter),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))
  446. CALL Copy_Ncdf_att(parent_batmet_name,TRIM(parent_bathy_meter),name)
  447. !
  448. WRITE(*,*) ' '
  449. WRITE(*,*) 'Writing bathymetry file: ',name
  450. WRITE(*,*) ' '
  451. !
  452. Write_Bathy_meter = 1
  453. !
  454. END FUNCTION Write_Bathy_meter
  455. !
  456. !*****************************************************
  457. ! function set_child_name(Parentname,Childname)
  458. !*****************************************************
  459. !
  460. SUBROUTINE set_child_name(Parentname,Childname)
  461. !
  462. CHARACTER(*),INTENT(in) :: Parentname
  463. CHARACTER(*),INTENT(out) :: Childname
  464. CHARACTER(2) :: prefix
  465. INTEGER :: pos
  466. !
  467. pos = INDEX(TRIM(Parentname),'/',back=.TRUE.)
  468. !
  469. prefix=Parentname(pos+1:pos+2)
  470. IF (prefix == '1_') THEN
  471. Childname = '2_'//Parentname(pos+3:LEN(Parentname))
  472. ELSEIF (prefix == '2_') THEN
  473. Childname = '3_'//Parentname(pos+3:LEN(Parentname))
  474. ELSEIF (prefix == '3_') THEN
  475. Childname = '4_'//Parentname(pos+3:LEN(Parentname))
  476. ELSEIF (prefix == '4_') THEN
  477. Childname = '5_'//Parentname(pos+3:LEN(Parentname))
  478. ELSE
  479. Childname = '1_'//Parentname(pos+1:LEN(Parentname))
  480. ENDIF
  481. !
  482. END SUBROUTINE set_child_name
  483. !
  484. !*****************************************************
  485. ! function set_child_name(Parentname,Childname)
  486. !*****************************************************
  487. !
  488. !*****************************************************
  489. ! subroutine get_interptype(varname,interp_type,conservation)
  490. !*****************************************************
  491. !
  492. SUBROUTINE get_interptype( varname,interp_type,conservation )
  493. !
  494. LOGICAL,OPTIONAL :: conservation
  495. CHARACTER(*) :: interp_type,varname
  496. INTEGER :: pos,pos1,pos2,pos3,i,k
  497. LOGICAL :: find
  498. i=1
  499. DO WHILE ( TRIM(VAR_INTERP(i)) .NE. 'NULL' )
  500. pos = INDEX( TRIM(VAR_INTERP(i)) , TRIM(varname) )
  501. IF ( pos .NE. 0 ) THEN
  502. pos1 = INDEX( TRIM(VAR_INTERP(i)) , 'bicubic' )
  503. pos2 = INDEX( TRIM(VAR_INTERP(i)) , 'bilinear' )
  504. pos3 = INDEX( TRIM(VAR_INTERP(i)) , 'conservative' )
  505. ! initialize interp_type
  506. IF( pos1 .NE. 0 ) interp_type = 'bicubic'
  507. IF( pos2 .NE. 0 ) interp_type = 'bilinear'
  508. IF( pos1 .EQ. 0 .AND. pos2 .EQ. 0) interp_type = 'bicubic'
  509. ! initialize conservation
  510. IF( pos3 .NE. 0 .AND. PRESENT(conservation) ) THEN
  511. conservation = .TRUE.
  512. RETURN
  513. ELSE
  514. conservation = .FALSE.
  515. ENDIF
  516. find = .FALSE.
  517. IF( PRESENT(conservation) ) THEN
  518. k=0
  519. conservation = .FALSE.
  520. DO WHILE( k < SIZE(flxtab) .AND. .NOT.find )
  521. k = k+1
  522. IF( TRIM(varname) .EQ. TRIM(flxtab(k)) ) THEN
  523. conservation = .TRUE.
  524. find = .TRUE.
  525. ENDIF
  526. END DO
  527. ENDIF
  528. RETURN
  529. ENDIF
  530. i = i+1
  531. END DO
  532. !default values interp_type = bicubic // conservation = false
  533. interp_type = 'bicubic'
  534. IF( PRESENT(conservation) ) conservation = .FALSE.
  535. RETURN
  536. !
  537. END SUBROUTINE get_interptype
  538. !
  539. !*****************************************************
  540. ! end subroutine get_interptype
  541. !*****************************************************
  542. !
  543. !*****************************************************
  544. ! subroutine Init_mask(name,Grid)
  545. !*****************************************************
  546. !
  547. SUBROUTINE Init_mask(name,Grid,jpiglo,jpjglo)
  548. !
  549. USE io_netcdf
  550. !
  551. CHARACTER(*) name
  552. INTEGER :: nx,ny,k,i,j,jpiglo,jpjglo
  553. TYPE(Coordinates) :: Grid
  554. REAL*8, POINTER, DIMENSION(:,:) ::zwf => NULL()
  555. !
  556. IF(jpiglo == 1 .AND. jpjglo == 1) THEN
  557. CALL Read_Ncdf_var('Bathy_level',name,Grid%Bathy_level)
  558. ELSE
  559. CALL Read_Ncdf_var('Bathy_level',name,Grid%Bathy_level,(/jpizoom,jpjzoom/),(/jpiglo,jpjglo/) )
  560. ENDIF
  561. !
  562. WRITE(*,*) 'Init masks in T,U,V,F points'
  563. !
  564. nx = SIZE(Grid%Bathy_level,1)
  565. ny = SIZE(Grid%Bathy_level,2)
  566. !
  567. !
  568. ALLOCATE(Grid%tmask(nx,ny,N), &
  569. Grid%umask(nx,ny,N), &
  570. Grid%vmask(nx,ny,N), &
  571. Grid%fmask(nx,ny,N))
  572. !
  573. DO k = 1,N
  574. !
  575. WHERE(Grid%Bathy_level(:,:) <= k-1 )
  576. Grid%tmask(:,:,k) = 0
  577. ELSEWHERE
  578. Grid%tmask(:,:,k) = 1
  579. END WHERE
  580. !
  581. END DO
  582. !
  583. Grid%umask(1:nx-1,:,:) = Grid%tmask(1:nx-1,:,:)*Grid%tmask(2:nx,:,:)
  584. Grid%vmask(:,1:ny-1,:) = Grid%tmask(:,1:ny-1,:)*Grid%tmask(:,2:ny,:)
  585. !
  586. Grid%umask(nx,:,:) = Grid%tmask(nx,:,:)
  587. Grid%vmask(:,ny,:) = Grid%tmask(:,ny,:)
  588. !
  589. Grid%fmask(1:nx-1,1:ny-1,:) = Grid%tmask(1:nx-1,1:ny-1,:)*Grid%tmask(2:nx,1:ny-1,:)* &
  590. Grid%tmask(1:nx-1,2:ny,:)*Grid%tmask(2:nx,2:ny,:)
  591. !
  592. Grid%fmask(nx,:,:) = Grid%tmask(nx,:,:)
  593. Grid%fmask(:,ny,:) = Grid%tmask(:,ny,:)
  594. !
  595. ALLOCATE(zwf(nx,ny))
  596. !
  597. DO k = 1,N
  598. !
  599. zwf(:,:) = Grid%fmask(:,:,k)
  600. !
  601. DO j = 2, ny-1
  602. DO i = 2,nx-1
  603. IF( Grid%fmask(i,j,k) == 0. ) THEN
  604. Grid%fmask(i,j,k) = shlat * MIN(1.,MAX( zwf(i+1,j),zwf(i,j+1),zwf(i-1,j),zwf(i,j-1)))
  605. END IF
  606. END DO
  607. END DO
  608. !
  609. DO j = 2, ny-1
  610. IF( Grid%fmask(1,j,k) == 0. ) THEN
  611. Grid%fmask(1,j,k) = shlat * MIN(1.,MAX(zwf(2,j),zwf(1,j+1),zwf(1,j-1)))
  612. ENDIF
  613. IF( Grid%fmask(nx,j,k) == 0. ) THEN
  614. Grid%fmask(nx,j,k) = shlat * MIN(1.,MAX(zwf(nx,j+1),zwf(nx-1,j),zwf(nx,j-1)))
  615. ENDIF
  616. END DO
  617. !
  618. DO i = 2, nx-1
  619. IF( Grid%fmask(i,1,k) == 0. ) THEN
  620. Grid%fmask(i, 1 ,k) = shlat*MIN( 1.,MAX(zwf(i+1,1),zwf(i,2),zwf(i-1,1)))
  621. ENDIF
  622. !
  623. IF( Grid%fmask(i,ny,k) == 0. ) THEN
  624. Grid%fmask(i,ny,k) = shlat * MIN(1.,MAX(zwf(i+1,ny),zwf(i-1,ny),zwf(i,ny-1)))
  625. ENDIF
  626. END DO
  627. !!
  628. END DO
  629. !!
  630. END SUBROUTINE Init_mask
  631. !
  632. !*****************************************************
  633. ! end subroutine Init_mask
  634. !*****************************************************
  635. !
  636. !*****************************************************
  637. ! subroutine Init_Tmask(name,Grid)
  638. !*****************************************************
  639. !
  640. SUBROUTINE Init_Tmask(name,Grid,jpiglo,jpjglo)
  641. !
  642. USE io_netcdf
  643. !
  644. CHARACTER(*) name
  645. INTEGER :: nx,ny,k,i,j,jpiglo,jpjglo
  646. TYPE(Coordinates) :: Grid
  647. REAL*8, POINTER, DIMENSION(:,:) ::zwf => NULL()
  648. !
  649. IF(jpiglo == 1 .AND. jpjglo == 1) THEN
  650. CALL Read_Ncdf_var('Bathy_level',name,Grid%Bathy_level)
  651. ELSE
  652. CALL Read_Ncdf_var('Bathy_level',name,Grid%Bathy_level,(/jpizoom,jpjzoom/),(/jpiglo,jpjglo/) )
  653. ENDIF
  654. !
  655. nx = SIZE(Grid%Bathy_level,1)
  656. ny = SIZE(Grid%Bathy_level,2)
  657. !
  658. WRITE(*,*) 'Init masks in T points'
  659. !
  660. ALLOCATE(Grid%tmask(nx,ny,N))
  661. !
  662. DO k = 1,N
  663. !
  664. WHERE(Grid%Bathy_level(:,:) <= k-1 )
  665. Grid%tmask(:,:,k) = 0.
  666. ELSEWHERE
  667. Grid%tmask(:,:,k) = 1.
  668. END WHERE
  669. !
  670. END DO
  671. !
  672. END SUBROUTINE Init_Tmask
  673. !
  674. !*****************************************************
  675. ! subroutine get_mask(name,Grid)
  676. !*****************************************************
  677. !
  678. SUBROUTINE get_mask(level,posvar,mask,filename)
  679. !
  680. USE io_netcdf
  681. !
  682. CHARACTER(*) filename
  683. CHARACTER(*) posvar
  684. INTEGER :: level, nx, ny
  685. LOGICAL,DIMENSION(:,:),POINTER :: mask
  686. INTEGER,DIMENSION(:,:),POINTER :: maskT,maskU,maskV
  687. !
  688. TYPE(Coordinates) :: Grid
  689. !
  690. CALL Read_Ncdf_var('Bathy_level',filename,Grid%Bathy_level)
  691. !
  692. nx = SIZE(Grid%Bathy_level,1)
  693. ny = SIZE(Grid%Bathy_level,2)
  694. ALLOCATE(maskT(nx,ny),mask(nx,ny))
  695. mask = .TRUE.
  696. !
  697. WHERE(Grid%Bathy_level(:,:) <= level-1 )
  698. maskT(:,:) = 0
  699. ELSEWHERE
  700. maskT(:,:) = 1
  701. END WHERE
  702. !
  703. SELECT CASE(posvar)
  704. !
  705. CASE('T')
  706. !
  707. WHERE(maskT > 0)
  708. mask = .TRUE.
  709. ELSEWHERE
  710. mask = .FALSE.
  711. END WHERE
  712. DEALLOCATE(maskT)
  713. !
  714. CASE('U')
  715. !
  716. ALLOCATE(maskU(nx,ny))
  717. maskU(1:nx-1,:) = maskT(1:nx-1,:)*maskT(2:nx,:)
  718. maskU(nx,:) = maskT(nx,:)
  719. WHERE(maskU > 0)
  720. mask = .TRUE.
  721. ELSEWHERE
  722. mask = .FALSE.
  723. END WHERE
  724. DEALLOCATE(maskU,maskT)
  725. !
  726. CASE('V')
  727. !
  728. ALLOCATE(maskV(nx,ny))
  729. maskV(:,1:ny-1) = maskT(:,1:ny-1)*maskT(:,2:ny)
  730. maskV(:,ny) = maskT(:,ny)
  731. WHERE(maskT > 0)
  732. mask = .TRUE.
  733. ELSEWHERE
  734. mask = .FALSE.
  735. END WHERE
  736. DEALLOCATE(maskV,maskT)
  737. !
  738. END SELECT
  739. !
  740. END SUBROUTINE get_mask
  741. !
  742. !*****************************************************
  743. ! end subroutine get_mask
  744. !*****************************************************
  745. !
  746. !
  747. !*****************************************************
  748. ! subroutine read_dimg_var(unit,irec,field)
  749. !*****************************************************
  750. !
  751. SUBROUTINE read_dimg_var(unit,irec,field,jpk)
  752. !
  753. INTEGER :: unit,irec,jpk
  754. REAL*8,DIMENSION(:,:,:,:),POINTER :: field
  755. INTEGER :: k
  756. !
  757. DO k = 1,jpk
  758. READ(unit,REC=irec) field(:,:,k,1)
  759. irec = irec + 1
  760. ENDDO
  761. !
  762. END SUBROUTINE read_dimg_var
  763. !
  764. !
  765. !*****************************************************
  766. ! subroutine read_dimg_var(unit,irec,field)
  767. !*****************************************************
  768. !
  769. SUBROUTINE write_dimg_var(unit,irec,field,jpk)
  770. !
  771. INTEGER :: unit,irec,jpk
  772. REAL*8,DIMENSION(:,:,:,:),POINTER :: field
  773. INTEGER :: k
  774. !
  775. DO k = 1,jpk
  776. WRITE(unit,REC=irec) field(:,:,k,1)
  777. irec = irec + 1
  778. ENDDO
  779. !
  780. END SUBROUTINE write_dimg_var
  781. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  782. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  783. END MODULE agrif_readwrite