doc-doxygen/html/qcscur_8f_source.html

00001       SUBROUTINE qcscur (psgr, kngx, kngy, psurf)
00002 C****
00003 C               *****************************
00004 C               * OASIS ROUTINE  -  LEVEL T *
00005 C               * -------------     ------- *
00006 C               *****************************
00007 C
00008 C**** *qcscur* - Arithmetic routine
00009 C
00010 C
00011 C     Purpose:
00012 C     -------
00013 C     Calculate surface element for orth.& curvil. grid.
00014 C     The input surface contains the Rearth**2 factor.
00015 C
00016 C**   Interface:
00017 C     ---------
00018 C       *CALL*  *qcscur(psgr, kngx, kngy, psurf)*
00019 C
00020 C     Input:
00021 C     -----
00022 C                psurf : grid square surface elements (real 2D)
00023 C                kngx  : number of longitudes
00024 C                kngy  : number of latitudes
00025 C
00026 C     Output:
00027 C     ------
00028 C                psgr  : spheric grid square surface elements (real 2D)
00029 C
00030 C     Workspace:
00031 C     ---------
00032 C     None
00033 C
00034 C     External:
00035 C     --------
00036 C     None
00037 C
00038 C     References:
00039 C     ----------
00040 C     O. Thual, Simple ocean-atmosphere interpolation.
00041 C               Part A: The method, EPICOA 0629 (1992)
00042 C               Part B: Software implementation, EPICOA 0630 (1992)
00043 C     See also OASIS manual (1995)
00044 C
00045 C     History:
00046 C     -------
00047 C       Version   Programmer     Date      Description
00048 C       -------   ----------     ----      -----------
00049 C       1.0       O. Thual       93/04/15  created
00050 C       1.1       E. Guilyardi   93/11/04  modified
00051 C       2.0       L. Terray      95/10/01  modified: new structure
00052 C
00053 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00054 C
00055 C* ---------------------------- Include files ---------------------------
00056 C
00057       USE mod_printing
00058       USE mod_unit
00059 C
00060 C* ---------------------------- Argument declarations -------------------
00061 C
00062       REAL (kind=ip_realwp_p) psurf(kngx,kngy)
00063       REAL (kind=ip_realwp_p) psgr(kngx,kngy)
00064 C
00065 C* ---------------------------- Poema verses ----------------------------
00066 C
00067 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00068 C
00069       IF (nlogprt .GE. 2) THEN
00070           WRITE(nulou,*) '***** * Entering ROUTINE qcscur ******* '
00071           CALL FLUSH(nulou)
00072       ENDIF
00073 C
00074 C*    1. Initializations
00075 C        ---------------
00076 C
00077       zradi = 6371229.
00078       zradi2 = zradi**2
00079       zradinv = 1. / zradi2
00080 C
00081 C
00082 C*    2. Surfaces
00083 C        --------
00084 C* Surface calculation
00085 C
00086       DO 210 j2 = 1, kngy
00087         DO 220 j1 = 1, kngx
00088           psgr(j1,j2) = psurf(j1,j2) * zradinv
00089  220    CONTINUE
00090  210  CONTINUE
00091 C
00092       IF (nlogprt .GE. 2) THEN
00093           WRITE(nulou,*) '***** * Leaving ROUTINE qcscur ******* '
00094           CALL FLUSH(nulou)
00095       ENDIF
00096 C
00097 C* End of routine
00098 C
00099       RETURN
00100       END
00101
00102
00103
00104
00105
00106
00107