UPP  001
 All Data Structures Files Functions Pages
CALPOT.f
Go to the documentation of this file.
1 
20  SUBROUTINE calpot(P1D,T1D,THETA)
21 
22 !
23  use ctlblk_mod, only: jsta, jend, spval, im
24 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
25  implicit none
26 !
27 ! SET REQUIRED CONSTANTS.
28  real,PARAMETER :: capa=0.28589641,p1000=1000.e2
29 !
30 ! DECLARE VARIABLES.
31 !
32  real,dimension(IM,jsta:jend),intent(in) :: p1d,t1d
33  real,dimension(IM,jsta:jend),intent(inout) :: theta
34 
35  integer i,j
36 !
37 !**********************************************************************
38 ! START CALPOT HERE.
39 !
40 ! COMPUTE THETA
41 !
42 !$omp parallel do private(i,j)
43  DO j=jsta,jend
44  DO i=1,im
45  IF(t1d(i,j) < spval) THEN
46 ! IF(ABS(P1D(I,J)) > 1.0) THEN
47  IF(p1d(i,j) > 1.0) THEN
48  theta(i,j) = t1d(i,j) * (p1000/p1d(i,j))**capa
49  ELSE
50  theta(i,j) = 0.0
51  ENDIF
52  ELSE
53  theta(i,j) = spval
54  ENDIF
55  ENDDO
56  ENDDO
57 ! do j = 180, 185
58 ! print *, ' me, j, p1d,t1d,theta = ',
59 ! * me, j, p1d(10,j),t1d(10,j),theta (10,j)
60 ! end do
61 ! stop
62 !
63 ! END OF ROUTINE.
64 !
65  RETURN
66  END