C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/ecco/Attic/cost_readsssfields.F,v 1.1 2003/11/06 22:10:07 heimbach Exp $ #include "COST_CPPOPTIONS.h" subroutine cost_ReadSSSFields( I irec, I mythid & ) c ================================================================== c SUBROUTINE cost_ReadSSSFields c ================================================================== c c o Read a given record of the SST data. c c started: Christian Eckert eckert@mit.edu 25-May-1999 c c changed: Christian Eckert eckert@mit.edu 25-Feb-2000 c c - Restructured the code in order to create a package c for the MITgcmUV. c c ================================================================== c SUBROUTINE cost_ReadSSSFields c ================================================================== implicit none c == global variables == #include "EEPARAMS.h" #include "SIZE.h" #include "PARAMS.h" #include "GRID.h" #include "cal.h" #include "ecco_cost.h" c == routine arguments == integer irec integer mythid c == local variables == integer bi,bj integer i,j,k integer itlo,ithi integer jtlo,jthi integer jmin,jmax integer imin,imax integer nobs integer sssrec integer beginsss integer beginrun _RL spval _RL vartile c == end of interface == parameter (spval = -90.0 ) ce --> there is certainly a better place for this. jtlo = mybylo(mythid) jthi = mybyhi(mythid) itlo = mybxlo(mythid) ithi = mybxhi(mythid) jmin = 1 jmax = sny imin = 1 imax = snx beginsss = sssstartdate(1)/10000 beginrun = modelstartdate(1)/10000 if ( beginsss .eq. beginrun ) then sssrec = mod(modelstartdate(1)/100,100) - & mod(sssstartdate(1)/100,100) + irec else sssrec = ( beginrun - beginsss - 1)*nmonthyear + & (nmonthyear - mod(sssstartdate(1)/100,100) + & 1) + mod(modelstartdate(1)/100,100) - 1 + irec endif if ( sssrec.gt.0 .and. sssdatfile .ne. ' ' ) then call mdsreadfield( sssdatfile, cost_iprec, cost_yftype, 1, & sssdat, sssrec, mythid ) else do bj = jtlo,jthi do bi = itlo,ithi do j = jmin,jmax do i = imin,imax sssdat(i,j,bi,bj)=spval enddo enddo enddo enddo endif nobs = 0 do bj = jtlo,jthi do bi = itlo,ithi k = 1 do j = jmin,jmax do i = imin,imax if (_hFacC(i,j,k,bi,bj) .eq. 0.) then sssmask(i,j,bi,bj) = 0. _d 0 else sssmask(i,j,bi,bj) = 1. _d 0 endif if (sssdat(i,j,bi,bj) .le. spval) then sssmask(i,j,bi,bj) = 0. _d 0 endif if (sssdat(i,j,bi,bj) .eq. 0. _d 0 ) then sssmask(i,j,bi,bj) = 0. _d 0 endif sssmask(i,j,bi,bj) = sssmask(i,j,bi,bj)*frame(i,j) sssdat(i,j,bi,bj) = sssdat(i,j,bi,bj)*sssmask(i,j,bi,bj) nobs = nobs + int(sssmask(i,j,bi,bj)) enddo enddo enddo enddo c-- Calculate the field variance for present subdomain. c-- One could of course do a global sum here. vartile = 0. _d 0 do bj = jtlo,jthi do bi = itlo,ithi do j = jmin,jmax do i = imin,imax vartile = vartile + sssdat(i,j,bi,bj)*sssdat(i,j,bi,bj) enddo enddo enddo enddo if (nobs .gt. 0) then vartile = vartile/float(nobs) else vartile = spval endif return end