Changeset 15540 for NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/IOM/iom.F90
- Timestamp:
- 2021-11-26T12:27:56+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/IOM/iom.F90
r14986 r15540 127 127 INTEGER :: inum 128 128 ! 129 REAL( wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds130 REAL( wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries129 REAL(dp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 130 REAL(dp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 131 131 LOGICAL :: ll_closedef 132 132 LOGICAL :: ll_exist … … 173 173 ! 174 174 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 175 CALL set_grid( "T", CASTWP(glamt), CASTWP(gphit), .FALSE., .FALSE. )175 CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 176 176 CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. ) 177 177 CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. ) 178 CALL set_grid( "W", CASTWP(glamt), CASTWP(gphit), .FALSE., .FALSE. )179 CALL set_grid( "F", CASTWP(glamf), CASTWP(gphif), .FALSE., .FALSE. )180 CALL set_grid_znl( CASTWP(gphit))178 CALL set_grid( "W", glamt, gphit, .FALSE., .FALSE. ) 179 CALL set_grid( "F", glamf, gphif, .FALSE., .FALSE. ) 180 CALL set_grid_znl( gphit ) 181 181 ! 182 182 IF( ln_cfmeta ) THEN ! Add additional grid metadata … … 186 186 CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 187 187 CALL iom_set_domain_attr("grid_F", area = real( e1e2f(Nis0:Nie0, Njs0:Nje0), dp)) 188 CALL set_grid_bounds( "T", CASTWP(glamf), CASTWP(gphif), CASTWP(glamt), CASTWP(gphit))188 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 189 189 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 190 190 CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv ) 191 CALL set_grid_bounds( "W", CASTWP(glamf), CASTWP(gphif), CASTWP(glamt), CASTWP(gphit))192 CALL set_grid_bounds( "F", CASTWP(glamt), CASTWP(gphit), CASTWP(glamf), CASTWP(gphif))191 CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit ) 192 CALL set_grid_bounds( "F", glamt, gphit, glamf, gphif ) 193 193 ENDIF 194 194 ENDIF … … 232 232 ENDIF 233 233 CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) ) 234 CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) )234 CALL iom_set_axis_attr( "ghw_abl", CASTDP(ghw_abl(2:jpka)) ) 235 235 236 236 ! Add vertical grid bounds … … 255 255 CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 256 256 257 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji, wp), ji=1,jpnfl) /) )257 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,dp), ji=1,jpnfl) /) ) 258 258 # if defined key_si3 259 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji, wp), ji=1,jpl) /) )259 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,dp), ji=1,jpl) /) ) 260 260 ! SIMIP diagnostics (4 main arctic straits) 261 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji, wp), ji=1,4) /) )261 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,dp), ji=1,4) /) ) 262 262 # endif 263 263 #if defined key_top … … 265 265 #endif 266 266 CALL iom_set_axis_attr( "icbcla", class_num ) 267 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20, wp) /) ) ! strange syntaxe and idea...268 CALL iom_set_axis_attr( "iax_26C", (/ REAL(26, wp) /) ) ! strange syntaxe and idea...269 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28, wp) /) ) ! strange syntaxe and idea...267 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,dp) /) ) ! strange syntaxe and idea... 268 CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,dp) /) ) ! strange syntaxe and idea... 269 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,dp) /) ) ! strange syntaxe and idea... 270 270 ! for diaprt, we need to define an axis which size can be 1 (default) or 5 (if the file subbasins.nc exists) 271 271 INQUIRE( FILE = 'subbasins.nc', EXIST = ll_exist ) 272 272 nbasin = 1 + 4 * COUNT( (/ll_exist/) ) 273 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji, wp), ji=1,nbasin) /) )273 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,dp), ji=1,nbasin) /) ) 274 274 ENDIF 275 275 ! … … 610 610 CALL xios_get_handle("domain_definition",domaingroup_hdl) 611 611 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 612 CALL set_grid("N", CASTWP(glamt), CASTWP(gphit), .TRUE., ld_rstr)612 CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr) 613 613 614 614 CALL xios_get_handle("axis_definition",axisgroup_hdl) … … 620 620 #if defined key_si3 621 621 CALL xios_add_child(axisgroup_hdl, axis_hdl, "numcat") 622 CALL iom_set_axis_attr( "numcat", (/ (REAL(ji, wp), ji=1,jpl) /) )622 CALL iom_set_axis_attr( "numcat", (/ (REAL(ji,dp), ji=1,jpl) /) ) 623 623 #endif 624 624 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_hgt") 625 CALL iom_set_axis_attr( "nav_hgt", (/ (REAL(ji, wp), ji=1,jpka) /) )625 CALL iom_set_axis_attr( "nav_hgt", (/ (REAL(ji,dp), ji=1,jpka) /) ) 626 626 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 627 627 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") … … 1196 1196 INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable 1197 1197 REAL(dp) :: zscf, zofs ! sacle_factor and add_offset 1198 REAL( wp) :: zsgn ! local value of psgn1198 REAL(dp) :: zsgn ! local value of psgn 1199 1199 INTEGER :: itmp ! temporary integer 1200 1200 CHARACTER(LEN=256) :: clinfo ! info character … … 1365 1365 !--- overlap areas and extra hallows (mpp) 1366 1366 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1367 CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill )1367 CALL lbc_lnk( 'iom', pv_r2d, cl_type, CASTSP(zsgn), kfillmode = kfill ) 1368 1368 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1369 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill )1369 CALL lbc_lnk( 'iom', pv_r3d, cl_type, CASTSP(zsgn), kfillmode = kfill ) 1370 1370 ENDIF 1371 1371 ! … … 1393 1393 CALL xios_recv_field( trim(cdvar), pv_r3d(:, :, :)) 1394 1394 IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1395 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill)1395 CALL lbc_lnk( 'iom', pv_r3d, cl_type, CASTSP(zsgn), kfillmode = kfill) 1396 1396 ENDIF 1397 1397 ELSEIF( PRESENT(pv_r2d) ) THEN … … 1399 1399 CALL xios_recv_field( trim(cdvar), pv_r2d(:, :)) 1400 1400 IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1401 CALL lbc_lnk('iom', pv_r2d, cl_type, zsgn, kfillmode = kfill)1401 CALL lbc_lnk('iom', pv_r2d, cl_type, CASTSP(zsgn), kfillmode = kfill) 1402 1402 ENDIF 1403 1403 ELSEIF( PRESENT(pv_r1d) ) THEN … … 1434 1434 SUBROUTINE iom_get_var( cdname, z2d) 1435 1435 CHARACTER(LEN=*), INTENT(in ) :: cdname 1436 REAL( wp), DIMENSION(jpi,jpj) :: z2d1436 REAL(dp), DIMENSION(jpi,jpj) :: z2d 1437 1437 #if defined key_xios 1438 1438 IF( xios_field_is_active( cdname, at_current_timestep_arg = .TRUE. ) ) THEN … … 1508 1508 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1509 1509 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1510 REAL( wp) , INTENT( out) :: patt0d ! read field1510 REAL(dp) , INTENT( out) :: patt0d ! read field 1511 1511 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1512 1512 ! … … 1519 1519 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1520 1520 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1521 REAL( wp), DIMENSION(:), INTENT( out) :: patt1d ! read field1521 REAL(dp), DIMENSION(:), INTENT( out) :: patt1d ! read field 1522 1522 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1523 1523 ! … … 1578 1578 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1579 1579 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1580 REAL( wp), DIMENSION(:), INTENT(in ) :: patt1d ! written field1580 REAL(dp), DIMENSION(:), INTENT(in ) :: patt1d ! written field 1581 1581 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1582 1582 ! … … 1938 1938 INTEGER :: indim 1939 1939 LOGICAL :: llattexist 1940 REAL( wp), ALLOCATABLE, DIMENSION(:) :: zreal1d1940 REAL(dp), ALLOCATABLE, DIMENSION(:) :: zreal1d 1941 1941 !!--------------------------------------------------------------------- 1942 1942 ! … … 2202 2202 !!---------------------------------------------------------------------- 2203 2203 CHARACTER(LEN=*) , INTENT(in) :: cdid 2204 REAL( wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis2205 REAL( wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds2204 REAL(dp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis 2205 REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 2206 2206 !!---------------------------------------------------------------------- 2207 2207 IF( PRESENT(paxis) ) THEN … … 2319 2319 !!---------------------------------------------------------------------- 2320 2320 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 2321 REAL( wp), DIMENSION(jpi,jpj), INTENT(in) :: plon2322 REAL( wp), DIMENSION(jpi,jpj), INTENT(in) :: plat2323 ! 2324 REAL( wp), DIMENSION(jpi,jpj,jpk) :: zmask2321 REAL(dp), DIMENSION(jpi,jpj), INTENT(in) :: plon 2322 REAL(dp), DIMENSION(jpi,jpj), INTENT(in) :: plat 2323 ! 2324 REAL(dp), DIMENSION(jpi,jpj,jpk) :: zmask 2325 2325 INTEGER :: jn 2326 2326 INTEGER, DIMENSION(nijtile) :: ini, inj, idb … … 2376 2376 !!---------------------------------------------------------------------- 2377 2377 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 2378 REAL( wp), DIMENSION(jpi,jpj) , INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coord. of a contiguous vertex of cell (i,j)2379 REAL( wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coord. of the point of cell (i,j)2378 REAL(dp), DIMENSION(jpi,jpj) , INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coord. of a contiguous vertex of cell (i,j) 2379 REAL(dp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coord. of the point of cell (i,j) 2380 2380 ! 2381 2381 INTEGER :: ji, jj, jn … … 2384 2384 ! bottom-left corner of 2385 2385 ! cell (i,j) 2386 REAL( wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j)2387 REAL( wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells2388 REAL( wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells2386 REAL(dp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 2387 REAL(dp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells 2388 REAL(dp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 2389 2389 !!---------------------------------------------------------------------- 2390 2390 ! … … 2436 2436 !! 2437 2437 !!---------------------------------------------------------------------- 2438 REAL( wp), DIMENSION(jpi,jpj), INTENT(in) :: plat2438 REAL(dp), DIMENSION(jpi,jpj), INTENT(in) :: plat 2439 2439 ! 2440 2440 INTEGER :: ix, iy 2441 REAL( wp), DIMENSION(:), ALLOCATABLE :: zlon2441 REAL(dp), DIMENSION(:), ALLOCATABLE :: zlon 2442 2442 !!---------------------------------------------------------------------- 2443 2443 ! … … 2490 2490 INTEGER :: ji, jg ! loop counters 2491 2491 INTEGER :: ix, iy ! i-,j- index 2492 REAL( wp) ,DIMENSION(11) :: zlontao ! longitudes of tao moorings2493 REAL( wp) ,DIMENSION( 7) :: zlattao ! latitudes of tao moorings2494 REAL( wp) ,DIMENSION( 4) :: zlonrama ! longitudes of rama moorings2495 REAL( wp) ,DIMENSION(11) :: zlatrama ! latitudes of rama moorings2496 REAL( wp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings2497 REAL( wp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings2492 REAL(dp) ,DIMENSION(11) :: zlontao ! longitudes of tao moorings 2493 REAL(dp) ,DIMENSION( 7) :: zlattao ! latitudes of tao moorings 2494 REAL(dp) ,DIMENSION( 4) :: zlonrama ! longitudes of rama moorings 2495 REAL(dp) ,DIMENSION(11) :: zlatrama ! latitudes of rama moorings 2496 REAL(dp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings 2497 REAL(dp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings 2498 2498 TYPE(xios_duration) :: f_op, f_of 2499 2499 !!---------------------------------------------------------------------- … … 2555 2555 !! 2556 2556 !!---------------------------------------------------------------------- 2557 REAL( wp), DIMENSION(:), INTENT(in) :: plon, plat ! longitudes/latitudes oft the mooring2557 REAL(dp), DIMENSION(:), INTENT(in) :: plon, plat ! longitudes/latitudes oft the mooring 2558 2558 ! 2559 2559 !!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name … … 2565 2565 INTEGER :: ji, jj, jg ! loop counters 2566 2566 INTEGER :: ix, iy ! i-,j- index 2567 REAL( wp) :: zlon, zlat2567 REAL(dp) :: zlon, zlat 2568 2568 !!---------------------------------------------------------------------- 2569 2569 DO jg = 1, SIZE(clgrd) … … 2586 2586 IF( zlon == -10. .AND. zlat == -8. ) zlat = -6. 2587 2587 IF( zlon == -10. .AND. zlat == 4. ) THEN ; zlon = 0. ; zlat = 0. ; ENDIF 2588 CALL dom_ngb( zlon, zlat, ix, iy, cl1 )2588 CALL dom_ngb( CASTSP(zlon), CASTSP(zlat), ix, iy, cl1 ) 2589 2589 IF( zlon >= 0. ) THEN 2590 2590 IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT( zlon), 'e' … … 2634 2634 INTEGER :: itrlen 2635 2635 INTEGER :: iyear, imonth, iday, isec 2636 REAL( wp) :: zsec2636 REAL(dp) :: zsec 2637 2637 LOGICAL :: llexist 2638 2638 TYPE(xios_duration) :: output_freq … … 2809 2809 SUBROUTINE iom_miss_val( cdname, pmiss_val ) 2810 2810 CHARACTER(LEN=*), INTENT(in ) :: cdname 2811 REAL( wp) , INTENT(out) :: pmiss_val2811 REAL(dp) , INTENT(out) :: pmiss_val 2812 2812 REAL(dp) :: ztmp_pmiss_val 2813 2813 #if defined key_xios
Note: See TracChangeset
for help on using the changeset viewer.
