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