ROMS_r215: /home/cholod/wd/peps/ROMS/romsagrif_r215/Roms_tools/Roms

00001 !
00002 ! $Id: zetabc.F,v 1.7 2005/10/07 15:32:41 pmarches Exp $
00003 !
00004 #ifndef CHILD
00005 !
00006 # include "cppdefs.h"
00007       subroutine zetabc_tile(Istr,Iend,Jstr,Jend)
00008 # ifdef AGRIF      
00009       use AGRIF_Util
00010       integer Istr,Iend,Jstr,Jend
00011       if (AGRIF_Root()) then
00012         call zetabc_parent_tile(Istr,Iend,Jstr,Jend)
00013       else
00014         call zetabc_child_tile(Istr,Iend,Jstr,Jend)
00015 c        call zetabc_interp_tile(Istr,Iend,Jstr,Jend)
00016       endif
00017       return
00018       end
00019 !
00020 ! PARENT
00021 !
00022       subroutine zetabc_parent_tile(Istr,Iend,Jstr,Jend)
00023 # endif
00024 !
00025 ! Set boundary conditions for free surface zeta(:,:,knew)
00026 ! for the parent grid.
00027 !
00028 #else
00029 !
00030 ! CHILD
00031 !
00032       subroutine zetabc_child_tile(Istr,Iend,Jstr,Jend)
00033 !
00034 ! Set boundary conditions for free surface zeta(:,:,knew)
00035 ! for the child grid.
00036 !
00037 #endif /* CHILD */
00038 !
00039 ! Common Code
00040 !
00041 # include "set_obc_definitions.h"
00042 !
00043       implicit none
00044       integer Istr,Iend,Jstr,Jend, i,j
00045       real cff,cx,dft,dfx, eps
00046       parameter (eps=1.D-20)
00047 #include "param.h"
00048 #include "boundary.h"
00049 #include "climat.h"
00050 #include "grid.h"
00051 #include "ocean2d.h"
00052 #include "scalars.h"
00053 #ifdef AGRIF
00054 #include "private_scratch.h"
00055       integer trd
00056 C$    integer omp_get_thread_num
00057 #endif
00058 !
00059 #include "compute_auxiliary_bounds.h"
00060 !
00061 !  If child grid, interpolate zeta from parent
00062 !
00063 #ifdef CHILD
00064       trd=0
00065 C$    trd=omp_get_thread_num()
00066       call zetabc_interp_tile(Istr,Iend,Jstr,Jend
00067      &                    ,A1dETA(1,9+5*NWEIGHT,trd)
00068      &                    ,A1dETA(1,11+7*NWEIGHT,trd)
00069      &                    ,A1dETA(1,13+9*NWEIGHT,trd)
00070      &                    ,A1dETA(1,15+9*NWEIGHT,trd)     
00071      &                    ,A1dXI(1,9+5*NWEIGHT,trd)
00072      &                    ,A1dXI(1,11+7*NWEIGHT,trd)
00073      &                    ,A1dXI(1,13+9*NWEIGHT,trd)
00074      &                    ,A1dXI(1,15+9*NWEIGHT,trd))
00075 #endif
00076 ! 
00077 #ifndef EW_COM_PERIODIC
00078 !
00079 !====================================================================
00080 !                            WESTERN BC
00081 !====================================================================
00082       if (WESTERN_EDGE) then
00083 # if defined OBC_COM_WEST && defined OBC_COM_ZORLANSKI
00084 !                                           Eastern edge Radiation BC
00085 !                                           ======= ==== ========= ==
00086         do j=JstrV-1,Jend
00087           dft=zeta(1,j,kstp)-zeta(1,j,knew)
00088           dfx=zeta(1,j,knew)-zeta(2,j,knew)
00089 
00090           if (dfx*dft .lt. 0.) dft=0.     ! <--  SUPPRESS INFLOW
00091 
00092           cx=dft*dfx
00093           cff=max(dfx*dfx, eps)
00094 
00095           zeta(0,j,knew)=(cff*zeta(0,j,kstp)+cx*zeta(1,j,knew))
00096      &                                                /(cff+cx)
00097 #  ifdef MASKING
00098      &                      *rmask(0,j)
00099 #  endif
00100         enddo
00101 # elif defined OBC_COM_WEST && defined OBC_COM_ZCHAPMAN
00102 !                                           Western edge Chapman BC
00103 !                                           ======= ==== ======= ==
00104         do j=JstrV-1,Jend
00105           cx=dtfast*pm(1,j)*sqrt(g*h(1,j))
00106           zeta(0,j,knew)=(zeta(0,j,kstp)+cx*zeta(1,j,knew))/(1.+cx)
00107 #  ifdef MASKING
00108      &                      *rmask(0,j)
00109 #  endif
00110         enddo
00111 # elif defined OBC_COM_WEST && defined OBC_COM_ZSPECIFIED
00112 !                                           Western edge Specified BC
00113 !                                           ======= ==== ========= ==
00114         do j=JstrV-1,Jend
00115 #   ifdef Z_FRC_BRY
00116           zeta(0,j,knew)=zetabry_west(j)
00117 #   else
00118           zeta(0,j,knew)=SSH(0,j)
00119 #   endif
00120 #  ifdef MASKING
00121      &                      *rmask(0,j)
00122 #  endif
00123         enddo
00124 # else
00125         do j=JstrV-1,Jend                     ! Western edge gradient BC
00126           zeta(0,j,knew)=zeta(1,j,knew)    ! ======= ==== ======== ==
00127 #  ifdef MASKING
00128      &                      *rmask(0,j)
00129 #  endif
00130         enddo
00131 # endif
00132       endif
00133 !
00134 !====================================================================
00135 !                            EASTERN BC
00136 !====================================================================
00137       if (EASTERN_EDGE) then
00138 #  if defined OBC_COM_EAST && defined OBC_COM_ZORLANSKI
00139 !                                           Eastern edge Radiation BC
00140 !                                           ======= ==== ========= ==
00141         do j=JstrV-1,Jend
00142           dft=zeta(Iend,j,kstp)-zeta(Iend,j,knew)
00143           dfx=zeta(Iend,j,knew)-zeta(Iend-1,j,knew)
00144 
00145           if (dfx*dft .lt. 0.) dft=0.     ! <--  SUPPRESS INFLOW
00146 
00147           cx=dft*dfx
00148           cff=max(dfx*dfx, eps)
00149 
00150           zeta(Iend+1,j,knew)=(cff*zeta(Iend+1,j,kstp)+
00151      &                              cx*zeta(Iend,j,knew))/(cff+cx)
00152 #  ifdef MASKING
00153      &                                            *rmask(Iend+1,j)
00154 #  endif
00155         enddo
00156 # elif defined OBC_COM_EAST && defined OBC_COM_ZCHAPMAN
00157 !                                           Eastern edge Chapman BC
00158 !                                           ======= ==== ======= ==
00159         do j=JstrV-1,Jend
00160           cx=dtfast*pm(Iend,j)*sqrt(g*h(Iend,j))
00161           zeta(Iend+1,j,knew)=(zeta(Iend+1,j,kstp)
00162      &                              +cx*zeta(Iend,j,knew))/(1.+cx)
00163 #  ifdef MASKING
00164      &                      *rmask(Iend+1,j)
00165 #  endif
00166         enddo
00167 # elif defined OBC_COM_EAST && defined OBC_COM_ZSPECIFIED
00168 !                                           Eastern edge Specified BC
00169 !                                           ======= ==== ========= ==
00170         do j=JstrV-1,Jend
00171 #   ifdef Z_FRC_BRY
00172           zeta(Iend+1,j,knew)=zetabry_east(j) 
00173 #   else
00174           zeta(Iend+1,j,knew)=SSH(Iend+1,j)
00175 #   endif
00176 #  ifdef MASKING
00177      &                      *rmask(Iend+1,j)
00178 #  endif
00179         enddo
00180 #  else
00181         do j=JstrV-1,Jend                         ! Eastern edge gradient BC
00182           zeta(Iend+1,j,knew)=zeta(Iend,j,knew)! ======= ==== ======== ==
00183 #  ifdef MASKING
00184      &                        *rmask(Iend+1,j)
00185 #  endif
00186         enddo
00187 # endif
00188       endif
00189 #endif        /* !EW_COM_PERIODIC */
00190 
00191 #ifndef NS_COM_PERIODIC
00192 !
00193 !====================================================================
00194 !                            SOUTHERN BC
00195 !====================================================================
00196       if (SOUTHERN_EDGE) then
00197 # if defined OBC_COM_SOUTH && defined OBC_COM_ZORLANSKI
00198 !                                           Southern edge Radiation BC
00199 !                                           ======= ==== ========= ==
00200         do i=IstrU-1,Iend
00201           dft=zeta(i,1,kstp)-zeta(i,1,knew)
00202           dfx=zeta(i,1,knew)-zeta(i,2,knew)
00203 
00204           if (dfx*dft .lt. 0.) dft=0.     ! <--  SUPPRESS INFLOW
00205 
00206           cx=dft*dfx
00207           cff=max(dfx*dfx, eps)
00208 
00209           zeta(i,0,knew)=(cff*zeta(i,0,kstp)+cx*zeta(i,1,knew))
00210      &                                                /(cff+cx)
00211 #  ifdef MASKING
00212      &                      *rmask(i,0)
00213 #  endif
00214         enddo
00215 # elif defined OBC_COM_SOUTH && defined OBC_COM_ZCHAPMAN
00216 !                                           Southern edge Chapman BC
00217 !                                           ======== ==== ======= ==
00218         do i=IstrU-1,Iend
00219           cx=dtfast*pn(i,1)*sqrt(g*h(i,1))
00220           zeta(i,0,knew)=(zeta(i,0,kstp)
00221      &                              +cx*zeta(i,1,knew))/(1.+cx)
00222 #  ifdef MASKING
00223      &                      *rmask(i,0)
00224 #  endif
00225         enddo         
00226 # elif defined OBC_COM_SOUTH && defined OBC_COM_ZSPECIFIED
00227 !                                           Southern edge Specified BC
00228 !                                           ======== ==== ========= ==
00229         do i=IstrU-1,Iend
00230 #   ifdef Z_FRC_BRY
00231           zeta(i,0,knew)=zetabry_south(i)
00232 #   else
00233           zeta(i,0,knew)=SSH(i,0)
00234 #   endif
00235 #  ifdef MASKING
00236      &                      *rmask(i,0)
00237 #  endif
00238         enddo         
00239 #  else
00240         do i=IstrU-1,Iend                    ! Southern edge gradient BC
00241           zeta(i,0,knew)=zeta(i,1,knew)   ! ======== ==== ======== ==
00242 #  ifdef MASKING
00243      &                      *rmask(i,0)
00244 #  endif
00245         enddo
00246 # endif  /* OBC_COM_SOUTH */
00247       endif
00248 !
00249 !====================================================================
00250 !                            NORTHERN BC
00251 !====================================================================
00252       if (NORTHERN_EDGE) then
00253 #  if defined OBC_COM_NORTH && defined OBC_COM_ZORLANSKI
00254 !                                           Northern edge Radiation BC
00255 !                                           ======= ==== ========= ==
00256         do i=IstrU-1,Iend
00257           dft=zeta(i,Jend,kstp)-zeta(i,Jend,knew)
00258           dfx=zeta(i,Jend,knew)-zeta(i,Jend-1,knew)
00259 
00260           if (dfx*dft .lt. 0.) dft=0.     ! <--  SUPPRESS INFLOW
00261 
00262           cx=dft*dfx
00263           cff=max(dfx*dfx, eps)
00264 
00265           zeta(i,Jend+1,knew)=(cff*zeta(i,Jend+1,kstp)+
00266      &                              cx*zeta(i,Jend,knew))/(cff+cx)
00267 #  ifdef MASKING
00268      &                                            *rmask(i,Jend+1)
00269 #  endif
00270         enddo
00271 # elif defined OBC_COM_NORTH && defined OBC_COM_ZCHAPMAN
00272 !                                           Northern edge Chapman BC
00273 !                                           ======== ==== ======= ==
00274         do i=IstrU-1,Iend
00275           cx=dtfast*pn(i,Jend)*sqrt(g*h(i,Jend))
00276           zeta(i,Jend+1,knew)=(zeta(i,Jend+1,kstp)
00277      &                              +cx*zeta(i,Jend,knew))/(1.+cx)
00278 #  ifdef MASKING
00279      &                      *rmask(i,Jend+1)
00280 #  endif
00281         enddo
00282 # elif defined OBC_COM_NORTH && defined OBC_COM_ZSPECIFIED
00283 !                                           Northern edge Specified BC
00284 !                                           ======== ==== ========= ==
00285         do i=IstrU-1,Iend
00286 #   ifdef Z_FRC_BRY
00287           zeta(i,Jend+1,knew)=zetabry_north(i)
00288 #   else
00289           zeta(i,Jend+1,knew)=SSH(i,Jend+1)
00290 #   endif
00291 #  ifdef MASKING
00292      &                      *rmask(i,Jend+1)
00293 #  endif
00294         enddo
00295 # else 
00296 !                                            Northern edge gradient BC
00297 !                                            ======== ==== ======== ==
00298         do i=IstrU-1,Iend
00299           zeta(i,Jend+1,knew)=zeta(i,Jend,knew)
00300 #  ifdef MASKING
00301      &                       *rmask(i,Jend+1)
00302 #  endif
00303         enddo
00304 # endif   /* OBC_COM_NORTH */
00305       endif
00306 #endif       /* !NS_COM_PERIODIC */
00307 !
00308 !====================================================================
00309 !                   CORNERS (between open boundaries)
00310 !====================================================================
00311 #if defined OBC_COM_SOUTH && defined OBC_COM_WEST
00312       if (SOUTHERN_EDGE .and. WESTERN_EDGE) then
00313         zeta(0,0,knew)=0.5*(zeta(1,0 ,knew)+zeta(0 ,1,knew))
00314 #  ifdef MASKING
00315      &                       *rmask(0,0)
00316 #  endif        
00317       endif
00318 #endif
00319 #if defined OBC_COM_SOUTH && defined OBC_COM_EAST
00320       if (SOUTHERN_EDGE .and. EASTERN_EDGE) then
00321         zeta(Iend+1,0,knew)=0.5*(zeta(Iend+1,1 ,knew)+zeta(Iend,0,knew))
00322 #  ifdef MASKING
00323      &                       *rmask(Iend+1,0)
00324 #  endif                
00325       endif
00326 #endif
00327 #if defined OBC_COM_NORTH && defined OBC_COM_WEST
00328       if (NORTHERN_EDGE .and. WESTERN_EDGE) then
00329         zeta(0,Jend+1,knew)=0.5*(zeta(0,Jend,knew)+zeta(1 ,Jend+1,knew))
00330 #  ifdef MASKING
00331      &                       *rmask(0,Jend+1)
00332 #  endif                
00333       endif
00334 #endif
00335 #if defined OBC_COM_NORTH && defined OBC_COM_EAST
00336       if (NORTHERN_EDGE .and. EASTERN_EDGE) then
00337         zeta(Iend+1,Jend+1,knew)=0.5*(zeta(Iend+1,Jend,knew)+
00338      &                            zeta(Iend,Jend+1,knew))
00339 #  ifdef MASKING
00340      &                       *rmask(Iend+1,Jend+1)
00341 #  endif             
00342       endif
00343 #endif
00344 !
00345       return
00346       end
00347 #ifndef CHILD
00348 # define CHILD
00349 # ifdef AGRIF
00350 #  include "zetabc.F"
00351 # endif
00352 # undef CHILD
00353 #endif  /* !CHILD */
00354  
00355
/home/cholod/wd/peps/ROMS/romsagrif_r215/Roms_tools/Roms_Agrif/zetabc.F
