[Dart-dev] [3275] DART/trunk/models/MITgcm_ocean/model_mod.f90:
Fixed several syntax things that the ibm xlf compiler would not take
nancy at subversion.ucar.edu
nancy at subversion.ucar.edu
Tue Mar 18 13:32:18 MDT 2008
An HTML attachment was scrubbed...
URL: http://mailman.ucar.edu/pipermail/dart-dev/attachments/20080318/2f91e03f/attachment.html
-------------- next part --------------
Modified: DART/trunk/models/MITgcm_ocean/model_mod.f90
===================================================================
--- DART/trunk/models/MITgcm_ocean/model_mod.f90 2008-03-17 21:37:17 UTC (rev 3274)
+++ DART/trunk/models/MITgcm_ocean/model_mod.f90 2008-03-18 19:32:18 UTC (rev 3275)
@@ -64,6 +64,11 @@
character(len=128) :: msgstring
+!! FIXME: on ifort, this must be 1
+!! on xlf, this must be 4
+!! see the comments in the read_2d_snapshot code for more info
+integer, parameter :: item_size_direct_read = 4
+
!------------------------------------------------------------------
!
! MITgcm namelist section: we want to share the 'data' namelist file
@@ -424,9 +429,9 @@
! DEBUG: since we are computing these, check to be sure
! they look right.
-do i=1, Nz
- print *, 'i, delZ(i), ZC(i) = ', i, delZ(i), ZC(i)
-enddo
+!do i=1, Nz
+! print *, 'i, delZ(i), ZC(i) = ', i, delZ(i), ZC(i)
+!enddo
! for now, leave ZG undefined. it really does have one
! more depth than we read in, so it isn't clear how to
@@ -969,25 +974,54 @@
type(location_type), intent(out) :: location
integer, intent(out), optional :: var_type
+real(R8) :: lat, lon, depth
+integer :: var_num, offset, lon_index, lat_index, depth_index
+
+print *, 'asking for meta data about index ', index_in
+
if (index_in < start_index(S_index+1)) then
- var_type = KIND_SALINITY
- !location = set_location(lon, lat, depth, VERTISHEIGHT)
+ if (present(var_type)) var_type = KIND_SALINITY
+ var_num = S_index
else if (index_in < start_index(T_index+1)) then
- var_type = KIND_TEMPERATURE
- !location =
+ if (present(var_type)) var_type = KIND_TEMPERATURE
+ var_num = T_index
else if (index_in < start_index(U_index+1)) then
- var_type = KIND_U_CURRENT_COMPONENT
- !location =
+ if (present(var_type)) var_type = KIND_U_CURRENT_COMPONENT
+ var_num = U_index
else if (index_in < start_index(V_index+1)) then
- var_type = KIND_V_CURRENT_COMPONENT
- !location =
+ if (present(var_type)) var_type = KIND_V_CURRENT_COMPONENT
+ var_num = V_index
else
- var_type = KIND_SEA_SURFACE_HEIGHT
- !location =
+ if (present(var_type)) var_type = KIND_SEA_SURFACE_HEIGHT
+ var_num = SSH_index
endif
-! something bad happened
+print *, 'var num = ', var_num
+! local offset into this var array
+offset = index_in - start_index(var_num)
+
+print *, 'offset = ', offset
+
+if (var_num == SSH_index) then
+ depth = 0.0
+ depth_index = 1
+else
+ depth_index = (offset / (Nx * Ny)) + 1
+ depth = ZC(depth_index)
+endif
+
+lat_index = (offset - ((depth_index-1)*Nx*Ny)) / Nx + 1
+lon_index = offset - ((depth_index-1)*Nx*Ny) - ((lat_index-1)*Nx) + 1
+
+print *, 'lon, lat, depth index = ', lon_index, lat_index, depth_index
+lon = XC(lon_index)
+lat = YC(lat_index)
+
+print *, 'lon, lat, depth = ', lon, lat, depth
+
+location = set_location(lon, lat, depth, VERTISHEIGHT)
+
end subroutine get_state_meta_data
@@ -1724,14 +1758,14 @@
call error_handler(E_ERR,'model_mod:read_meta',msgstring,source,revision,revdate)
endif
-write(iunit, "(A,I,A)") "nDims = [ ", metadata%nDims, " ];"
+write(iunit, "(A,I5,A)") "nDims = [ ", metadata%nDims, " ];"
write(iunit, "(A)") "dimList = [ "
do i=1, metadata%nDims-1
- write(iunit, "(3(I,A))") metadata%dimList(i), ',', &
+ write(iunit, "(3(I5,A))") metadata%dimList(i), ',', &
1, ',', &
metadata%dimList(i), ','
enddo
-write(iunit, "(3(I,A))") metadata%dimList(i), ',', &
+write(iunit, "(3(I5,A))") metadata%dimList(i), ',', &
1, ',', &
metadata%dimList(i), ' '
@@ -1739,9 +1773,9 @@
write(iunit, "(3A)") "dataprec = [ ", trim(metadata%dataprec), " ];"
-write(iunit, "(A,I,A)") "nrecords = [ ", metadata%nrecords, " ];"
+write(iunit, "(A,I5,A)") "nrecords = [ ", metadata%nrecords, " ];"
-write(iunit, "(A,I,A)") "timeStepNumber = [ ", metadata%timeStepNumber, " ];"
+write(iunit, "(A,I8,A)") "timeStepNumber = [ ", metadata%timeStepNumber, " ];"
close(iunit)
@@ -1801,7 +1835,9 @@
write(*,*)'shape ',shape(x)
-reclen = product(shape(x))
+!! FIXME: on the ibms this must be times the item size;
+!! on the ifort compiler it is just the number of items
+reclen = product(shape(x)) * item_size_direct_read
! Get next available unit number, read file.
@@ -1812,8 +1848,10 @@
call error_handler(E_ERR,'model_mod:read_2d_snapshot',msgstring,source,revision,revdate)
endif
+print *, 'ready to read 2d snapshot, reclen = ', reclen
read(iunit, rec=1, iostat = io) x
if (io /= 0) then
+print *, 'failed read, iostat = ', io
write(msgstring,*) 'unable to read snapshot file ', trim(datafilename)
call error_handler(E_ERR,'read_2d_snapshot',msgstring,source,revision,revdate)
endif
@@ -1874,7 +1912,7 @@
allocate(x(metadata%dimList(1), metadata%dimList(2), metadata%dimList(3)))
-reclen = product(shape(x))
+reclen = product(shape(x)) * item_size_direct_read
! Get next available unit number, read file.
@@ -1942,7 +1980,7 @@
call write_meta(metadata, fbase)
-reclen = metadata%reclen
+reclen = metadata%reclen * item_size_direct_read
iunit = get_unit()
open(unit=iunit, file=datafilename, action='write', access='direct', recl=reclen, iostat=io)
@@ -1992,7 +2030,7 @@
call write_meta(metadata, fbase)
-reclen = metadata%reclen
+reclen = metadata%reclen * item_size_direct_read
! Get next available unit number, write file.
@@ -2167,31 +2205,31 @@
! check shapes
if (size(s,1) /= Nx) then
- write(msgstring,*),'dim 1 of S /= Nx ',size(s,1),Nx
+ write(msgstring,*) 'dim 1 of S /= Nx ',size(s,1),Nx
call error_handler(E_ERR,'model_mod:prog_var_to_vector', &
msgstring,source,revision,revdate)
endif
if (size(s,2) /= Ny) then
- write(msgstring,*),'dim 2 of S /= Nx ',size(s,2),Nx
+ write(msgstring,*) 'dim 2 of S /= Ny ',size(s,2),Ny
call error_handler(E_ERR,'model_mod:prog_var_to_vector', &
msgstring,source,revision,revdate)
endif
if (size(s,3) /= Nz) then
- write(msgstring,*),'dim 3 of S /= Nx ',size(s,3),Nx
+ write(msgstring,*) 'dim 3 of S /= Nz ',size(s,3),Nz
call error_handler(E_ERR,'model_mod:prog_var_to_vector', &
msgstring,source,revision,revdate)
endif
if (size(ssh,1) /= Nx) then
- write(msgstring,*),'dim 1 of SSH /= Nx ',size(ssh,1),Nx
+ write(msgstring,*) 'dim 1 of SSH /= Nx ',size(ssh,1),Nx
call error_handler(E_ERR,'model_mod:prog_var_to_vector', &
msgstring,source,revision,revdate)
endif
if (size(ssh,2) /= Ny) then
- write(msgstring,*),'dim 2 of SSH /= Ny ',size(ssh,2),Ny
+ write(msgstring,*) 'dim 2 of SSH /= Ny ',size(ssh,2),Ny
call error_handler(E_ERR,'model_mod:prog_var_to_vector', &
msgstring,source,revision,revdate)
endif
@@ -2269,31 +2307,31 @@
! check shapes
if (size(s,1) /= Nx) then
- write(msgstring,*),'dim 1 of S /= Nx ',size(s,1),Nx
+ write(msgstring,*) 'dim 1 of S /= Nx ',size(s,1),Nx
call error_handler(E_ERR,'model_mod:vector_to_prog_var', &
msgstring,source,revision,revdate)
endif
if (size(s,2) /= Ny) then
- write(msgstring,*),'dim 2 of S /= Nx ',size(s,2),Nx
+ write(msgstring,*) 'dim 2 of S /= Ny ',size(s,2),Ny
call error_handler(E_ERR,'model_mod:vector_to_prog_var', &
msgstring,source,revision,revdate)
endif
if (size(s,3) /= Nz) then
- write(msgstring,*),'dim 3 of S /= Nx ',size(s,3),Nx
+ write(msgstring,*) 'dim 3 of S /= Nz ',size(s,3),Nz
call error_handler(E_ERR,'model_mod:vector_to_prog_var', &
msgstring,source,revision,revdate)
endif
if (size(ssh,1) /= Nx) then
- write(msgstring,*),'dim 1 of SSH /= Nx ',size(ssh,1),Nx
+ write(msgstring,*) 'dim 1 of SSH /= Nx ',size(ssh,1),Nx
call error_handler(E_ERR,'model_mod:vector_to_prog_var', &
msgstring,source,revision,revdate)
endif
-if (size(ssh,2) /= Nx) then
- write(msgstring,*),'dim 2 of SSH /= Nx ',size(ssh,2),Nx
+if (size(ssh,2) /= Ny) then
+ write(msgstring,*) 'dim 2 of SSH /= Ny ',size(ssh,2),Ny
call error_handler(E_ERR,'model_mod:vector_to_prog_var', &
msgstring,source,revision,revdate)
endif
More information about the Dart-dev
mailing list