pkg/profiles/profiles_inloop.F

24462d2fa8 Patr*0001 #include "PROFILES_OPTIONS.h"
36c7a91797 Gael*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
6a770e0a24 Patr*0005
                0006 C     o==========================================================o
                0007 C     | subroutine profiles_inloop                               |
                0008 C     | o computes and writes model counterparts                 |
                0009 C     |   for netcdf profiles data                               |
                0010 C     | started: Gael Forget 15-March-2006                       |
                0011 C     o==========================================================o
                0012
65754df434 Mart*0013       SUBROUTINE profiles_inloop(myTime,myThid )
6a770e0a24 Patr*0014
65754df434 Mart*0015       IMPLICIT NONE
6a770e0a24 Patr*0016
                0017 C ==================== Global Variables ===========================
                0018 #include "EEPARAMS.h"
                0019 #include "SIZE.h"
                0020 #include "GRID.h"
                0021 #include "DYNVARS.h"
                0022 #include "PARAMS.h"
24462d2fa8 Patr*0023 #ifdef ALLOW_CAL
6a770e0a24 Patr*0024 #include "cal.h"
24462d2fa8 Patr*0025 #endif
                0026 #ifdef ALLOW_CTRL
65754df434 Mart*0027 #include "OPTIMCYCLE.h"
24462d2fa8 Patr*0028 #endif
                0029 #ifdef ALLOW_PROFILES
6328b73337 Gael*0030 # include "PROFILES_SIZE.h"
6e4c90fea3 Patr*0031 # include "profiles.h"
                0032 # include "netcdf.inc"
                0033 #endif
6a770e0a24 Patr*0034 C ==================== Routine Variables ==========================
                0035
65754df434 Mart*0036       _RL myTime
6e4c90fea3 Patr*0037       integer myThid
                0038
24462d2fa8 Patr*0039 #ifdef ALLOW_PROFILES
6e4c90fea3 Patr*0040
                0041 C ==================== Local Variables ==========================
                0042       integer k,bi,bj,prof_num, num_file, num_var
f0e4bffe35 Gael*0043       _RL prof_traj1D(NLEVELMAX),prof_mask1D(NLEVELMAX)
ba63501b4c Gael*0044       integer prof_i1D(NUM_INTERP_POINTS),prof_j1D(NUM_INTERP_POINTS)
                0045       _RL prof_w1D(NUM_INTERP_POINTS)
24462d2fa8 Patr*0046 #ifndef ALLOW_CTRL
                0047       integer optimcycle
                0048 #endif
da0e0765ef An T*0049 #ifndef ALLOW_ECCO
                0050       integer i,j
                0051 #endif
65754df434 Mart*0052
6a770e0a24 Patr*0053 c     == end of interface ==
                0054
24462d2fa8 Patr*0055 #ifndef ALLOW_CTRL
                0056       optimcycle = 0
                0057 #endif
                0058
65754df434 Mart*0059         _BEGIN_MASTER( myThid )
6cc0cb518f Gael*0060
da0e0765ef An T*0061 #ifndef ALLOW_ECCO
                0062       DO bj=myByLo(myThid),myByHi(myThid)
                0063        DO bi=myBxLo(myThid),myBxHi(myThid)
65754df434 Mart*0064           do k = 1,Nr
da0e0765ef An T*0065             do j = 1,sNy
                0066               do i =  1,sNx
                0067                 m_UE(i,j,k,bi,bj)=0. _d 0
                0068                 m_VN(i,j,k,bi,bj)=0. _d 0
                0069               enddo
                0070             enddo
                0071           enddo
                0072         enddo
                0073       enddo
                0074
                0075       CALL ROTATE_UV2EN_RL(
                0076      U          uVel, vVel, m_UE, m_VN,
65754df434 Mart*0077      I          .TRUE., .TRUE., .FALSE., Nr, myThid )
da0e0765ef An T*0078 #endif /* ALLOW_ECCO */
                0079
6cc0cb518f Gael*0080       DO bj=1,nSy
                0081        DO bi=1,nSx
6a770e0a24 Patr*0082
                0083       do num_file=1,NFILESPROFMAX
                0084       do prof_num=1,NOBSGLOB
71a5587721 Gael*0085       if (prof_num.LE.ProfNo(num_file,bi,bj)) then
65754df434 Mart*0086       if ((prof_time(num_file,prof_num,bi,bj).GE.myTime).AND.
                0087      & (prof_time(num_file,prof_num,bi,bj).LT.(myTime+deltaTClock)))
71a5587721 Gael*0088      & then
6a770e0a24 Patr*0089
ba63501b4c Gael*0090       do k=1,NUM_INTERP_POINTS
                0091       prof_i1D(k)= prof_interp_i(num_file,prof_num,k,bi,bj)
                0092       prof_j1D(k)= prof_interp_j(num_file,prof_num,k,bi,bj)
                0093       prof_w1D(k)= prof_interp_weights(num_file,prof_num,k,bi,bj)
                0094       enddo
                0095
ea4d09597a Gael*0096       do num_var=1,NVARMAX
6a770e0a24 Patr*0097       do k=1,NLEVELMAX
                0098       prof_traj1D(k)=0
                0099       prof_mask1D(k)=0
                0100       enddo
71a5587721 Gael*0101       if (vec_quantities(num_file,num_var,bi,bj).EQV..TRUE.) then
39ce977435 Gael*0102         call profiles_interp(prof_traj1D,
                0103      &        prof_i1D,prof_j1D,prof_w1D,
cf16ba6028 Gael*0104      &        prof_namesmod(num_file,num_var),
                0105      &        prof_itracer(num_file,num_var),
65754df434 Mart*0106      &        num_file,myTime,bi,bj,myThid)
fd8f717f84 Gael*0107         do k=1,NLEVELMAX
                0108           prof_traj1D(k)=prof_traj1D(k)*
                0109      &                   prof_facmod(num_file,num_var)
                0110         enddo
f0e4bffe35 Gael*0111         call active_write_profile(num_file,
                0112      &      ProfDepthNo(num_file,bi,bj),prof_traj1D,num_var,
65754df434 Mart*0113      &      prof_num,optimcycle,bi,bj,myThid,
f0e4bffe35 Gael*0114      &      profiles_dummy(num_file,num_var,bi,bj))
6a770e0a24 Patr*0115       endif
                0116       enddo
                0117
                0118       endif !if ((prof_time...
71a5587721 Gael*0119       endif !if (ProfNo(num_file,bi,bj).NE.0) then
6a770e0a24 Patr*0120       enddo !do prof_num...
                0121       enddo !do num_file=1,NFILESPROFMAX
6cc0cb518f Gael*0122        ENDDO
6a770e0a24 Patr*0123       ENDDO
6cc0cb518f Gael*0124
65754df434 Mart*0125         _END_MASTER( myThid )
6a770e0a24 Patr*0126
6e4c90fea3 Patr*0127 #endif
6a770e0a24 Patr*0128
                0129        END
                0130