| 1 |
C $Header: /u/gcmpack/MITgcm/pkg/profiles/profiles_readvector.F,v 1.8 2007/06/15 04:49:31 gforget Exp $ |
| 2 |
C $Name: $ |
| 3 |
|
| 4 |
#include "PROFILES_OPTIONS.h" |
| 5 |
|
| 6 |
C o==========================================================o |
| 7 |
C | subroutine profiles_readvector | |
| 8 |
C | o reads a profile from a netcdf profiles data file | |
| 9 |
C | started: Gael Forget 15-March-2006 | |
| 10 |
C o==========================================================o |
| 11 |
|
| 12 |
SUBROUTINE profiles_readvector(fNb, vNb, irec, |
| 13 |
& vec_loc_length, vec_loc , bi,bj, myThid) |
| 14 |
|
| 15 |
implicit none |
| 16 |
|
| 17 |
C ==================== Global Variables =========================== |
| 18 |
#include "EEPARAMS.h" |
| 19 |
#include "SIZE.h" |
| 20 |
#include "GRID.h" |
| 21 |
#include "DYNVARS.h" |
| 22 |
#ifdef ALLOW_PROFILES |
| 23 |
#include "netcdf.inc" |
| 24 |
#include "profiles.h" |
| 25 |
#endif |
| 26 |
C ==================== Routine Variables ========================== |
| 27 |
integer vec_loc_length, vNb, k, kk, kkk,bi,bj |
| 28 |
integer irec, fNb, myThid,err,varid1,tmpprofno |
| 29 |
_RL vec_loc(vec_loc_length) |
| 30 |
|
| 31 |
#ifdef ALLOW_PROFILES |
| 32 |
|
| 33 |
integer vec_start(2),vec_count(2) |
| 34 |
_RL vec_tmp1(1000*NLEVELMAX),vec_tmp2(1000*NLEVELMAX) |
| 35 |
character*(max_len_mbuf) msgbuf |
| 36 |
|
| 37 |
c-- == end of interface == |
| 38 |
|
| 39 |
|
| 40 |
if ( (irec.LT.profiles_minind_buff(bi,bj)).OR. |
| 41 |
& (irec.GT.profiles_maxind_buff(bi,bj)).OR. |
| 42 |
& (profiles_curfile_buff(bi,bj).NE.fNb) ) then |
| 43 |
err = NF_INQ_DIMID(fiddata(fNb,bi,bj),'iPROF', varid1) |
| 44 |
err = NF_INQ_DIMLEN(fiddata(fNb,bi,bj), varid1, tmpprofno) |
| 45 |
|
| 46 |
if (profiles_curfile_buff(bi,bj).NE.fNb) then |
| 47 |
c no asumption on whether a forward or a backward loop is calling |
| 48 |
profiles_minind_buff(bi,bj)=max(1,irec-500+1) |
| 49 |
profiles_maxind_buff(bi,bj)=min(tmpprofno,irec+500) |
| 50 |
elseif (irec.LT.profiles_minind_buff(bi,bj)) then |
| 51 |
c implies that a backward loop is calling |
| 52 |
profiles_minind_buff(bi,bj)=max(1,irec-999) |
| 53 |
profiles_maxind_buff(bi,bj)=irec |
| 54 |
else |
| 55 |
c implies that a forward loop is calling |
| 56 |
profiles_minind_buff(bi,bj)=irec |
| 57 |
profiles_maxind_buff(bi,bj)=min(tmpprofno,irec+999) |
| 58 |
endif |
| 59 |
|
| 60 |
write(msgbuf,'(a,5I9)') |
| 61 |
& 'buffer readvector ', |
| 62 |
& profiles_minind_buff(bi,bj), profiles_maxind_buff(bi,bj), |
| 63 |
& irec, profNo(fNb,bi,bj), tmpprofno |
| 64 |
call print_message( |
| 65 |
& msgbuf, standardmessageunit, SQUEEZE_RIGHT , mythid) |
| 66 |
|
| 67 |
vec_start(1)=1 |
| 68 |
vec_start(2)=profiles_minind_buff(bi,bj) |
| 69 |
vec_count(1)=vec_loc_length |
| 70 |
vec_count(2)= |
| 71 |
& profiles_maxind_buff(bi,bj)-profiles_minind_buff(bi,bj)+1 |
| 72 |
|
| 73 |
do kkk=1,NVARMAX |
| 74 |
if (vec_quantities(fNb,kkk,bi,bj).EQV..TRUE.) then |
| 75 |
err = NF_INQ_VARID(fiddata(fNb,bi,bj),prof_names(kkk), |
| 76 |
& varid1 ) |
| 77 |
err = NF_GET_VARA_DOUBLE(fiddata(fNb,bi,bj), varid1 , vec_start, |
| 78 |
& vec_count, vec_tmp1) |
| 79 |
err = NF_INQ_VARID(fiddata(fNb,bi,bj),prof_namesweight(kkk) |
| 80 |
& , varid1 ) |
| 81 |
err = NF_GET_VARA_DOUBLE(fiddata(fNb,bi,bj), varid1 , vec_start, |
| 82 |
& vec_count, vec_tmp2) |
| 83 |
|
| 84 |
if (err.NE.NF_NOERR) then |
| 85 |
WRITE(errorMessageUnit,'(A)') |
| 86 |
& 'WARNING in profiles_readvector: record not found!!' |
| 87 |
endif |
| 88 |
|
| 89 |
do k=1,vec_count(1) |
| 90 |
do kk=1,vec_count(2) |
| 91 |
profiles_data_buff(k,kk,kkk,bi,bj)=vec_tmp1((kk-1)*vec_count(1)+k) |
| 92 |
profiles_weight_buff(k,kk,kkk,bi,bj)=vec_tmp2((kk-1)*vec_count(1) |
| 93 |
& +k) |
| 94 |
enddo |
| 95 |
enddo |
| 96 |
endif |
| 97 |
enddo |
| 98 |
|
| 99 |
profiles_curfile_buff(bi,bj)=fNb |
| 100 |
endif |
| 101 |
|
| 102 |
cgf ...now, get vec_loc from the buffer |
| 103 |
if (vNb.LT.0) then |
| 104 |
do k=1,vec_loc_length |
| 105 |
vec_loc(k)= profiles_weight_buff |
| 106 |
& (k,irec-profiles_minind_buff(bi,bj)+1,-vNb,bi,bj) |
| 107 |
enddo |
| 108 |
|
| 109 |
else |
| 110 |
do k=1,vec_loc_length |
| 111 |
vec_loc(k)=profiles_data_buff |
| 112 |
& (k,irec-profiles_minind_buff(bi,bj)+1,vNb,bi,bj) |
| 113 |
enddo |
| 114 |
endif |
| 115 |
|
| 116 |
#endif |
| 117 |
|
| 118 |
END |
Parent Directory
| 
Revision Log
| 
Revision Graph