Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:37:32 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
09a6f3668a Jeff*0001 #include "ctrparam.h"
                0002 #include "ATM2D_OPTIONS.h"
                0003 
                0004 C     !INTERFACE:
                0005       SUBROUTINE READ_ATMOS(inMonth,myThid )
                0006 C     *==========================================================*
                0007 C     | o Takes atmos data on atmos grid, converts to ocean      |
                0008 C     |   model units, and combines the polar cap atmos cell     |
                0009 C     |   with its neighbor to the north or south.               |
                0010 C     *==========================================================*
                0011         IMPLICIT NONE
                0012 
                0013 C     === Global Atmos/Ocean/Seaice Interface Variables ===
                0014 #include "ATMSIZE.h"
                0015 #include "AGRID.h"
                0016 #include "SIZE.h"
                0017 #include "EEPARAMS.h"
                0018 #include "PARAMS.h"
                0019 #include "ATM2D_VARS.h"
                0020 
                0021       _RL secDay1000
                0022       PARAMETER (secDay1000= 86400000.D0)
                0023 
                0024 C     !INPUT/OUTPUT PARAMETERS:
                0025 C     === Routine arguments ===
                0026 C     inMonth - current month (or forcing period)
                0027 C     myThid - Thread no. that called this routine.
                0028       INTEGER inMonth
                0029       INTEGER myThid
                0030 
                0031 C     LOCAL VARIABLES:
                0032       _RL a1,a2
                0033       INTEGER j_atm
                0034 
                0035 C Keep track of (raw) atmos variables for diagnostics
                0036       DO j_atm=1,jm0
                0037         sum_tauu_ta(j_atm,inMonth)= sum_tauu_ta(j_atm,inMonth) +
                0038      &                           tauu(j_atm)*dtatmo
9274434acc Jean*0039         sum_tauv_ta(j_atm,inMonth)= sum_tauv_ta(j_atm,inMonth) +
09a6f3668a Jeff*0040      &                           tauv(j_atm)*dtatmo
9274434acc Jean*0041         sum_wsocean_ta(j_atm,inMonth)= sum_wsocean_ta(j_atm,inMonth) +
09a6f3668a Jeff*0042      &                           wsocean(j_atm)*dtatmo
9274434acc Jean*0043         sum_ps4ocean_ta(j_atm,inMonth)= sum_ps4ocean_ta(j_atm,inMonth) +
09a6f3668a Jeff*0044      &                           ps4ocean(j_atm)*dtatmo
                0045       ENDDO
                0046 
                0047 C
                0048 C put atmospheric data onto local arrays and convert units for ocean model
                0049 C
                0050       DO j_atm=1,jm0
                0051 
                0052         atm_tauu(j_atm) = tauu(j_atm)
                0053         atm_tauv(j_atm) = tauv(j_atm)
                0054         atm_tair(j_atm) = tempr(j_atm)
b926efee65 Jeff*0055         atm_precip(j_atm)    = -precip(j_atm)/secDay1000
                0056         atm_runoff(j_atm)    = -arunoff(j_atm)/secDay1000
                0057         atm_evap_ice(j_atm)  = -evai(j_atm)/secDay1000
                0058         atm_evap_ocn(j_atm)  = -evao(j_atm)/secDay1000
                0059         atm_qnet_ice(j_atm)  = -hfluxi(j_atm)
                0060         atm_qnet_ocn(j_atm)  = -hfluxo(j_atm)
                0061         atm_dFdt_ice(j_atm)  = -dhfidtg(j_atm)
                0062         atm_dFdt_ocn(j_atm)  = -dhfodtg(j_atm)
09a6f3668a Jeff*0063 C       Ice feels evap from model, no change with temperature
b926efee65 Jeff*0064         atm_dLdt_ice(j_atm)  = 0. _d 0  ! -devidtg(j_atm)/secDay1000
                0065         atm_dLdt_ocn(j_atm)  = -devodtg(j_atm)/secDay1000
09a6f3668a Jeff*0066         atm_dFdt_iceq(j_atm) = -dhfidtgeq(j_atm)
                0067         atm_dFdt_ocnq(j_atm) = -dhfodtgeq(j_atm)
b926efee65 Jeff*0068         atm_dLdt_iceq(j_atm) = 0. _d 0  ! -devidtgeq(j_atm)/secDay1000
0efd285817 Jeff*0069         atm_dLdt_ocnq(j_atm) = -devodtgeq(j_atm)/secDay1000
b926efee65 Jeff*0070         atm_solarinc(j_atm)  = solarinc_ice(j_atm)
09a6f3668a Jeff*0071         atm_solar_ocn(j_atm) = solarnet_ocean(j_atm)
                0072         atm_solar_ice(j_atm) = solarnet_ice(j_atm)
                0073         atm_windspeed(j_atm) = wsocean(j_atm)
4442a1784b Jeff*0074         atm_slp(j_atm) = ps4ocean(j_atm)*1013.25/984.0 - 1013.25
b926efee65 Jeff*0075         atm_pco2(j_atm) = co24ocean(j_atm)
                0076 
09a6f3668a Jeff*0077       ENDDO
                0078 
9274434acc Jean*0079       IF (cflan(2).NE.1. _d 0)
0efd285817 Jeff*0080      &          CALL COMBINE_ENDS(endwgt1,endwgt2,1,2,rsumwgt)
9274434acc Jean*0081       IF (cflan(jm0-1).NE.1. _d 0)
0efd285817 Jeff*0082      &          CALL COMBINE_ENDS(endwgt1,endwgt2,jm0,jm0-1,rsumwgt)
09a6f3668a Jeff*0083 
                0084       RETURN
                0085       END
                0086 
                0087 C--------------------------------------------------------------------------
                0088 #include "ctrparam.h"
                0089 #include "ATM2D_OPTIONS.h"
                0090 
                0091 
0efd285817 Jeff*0092       SUBROUTINE COMBINE_ENDS(a1,a2,ind1,ind2,rsuma)
09a6f3668a Jeff*0093 C     *==========================================================*
                0094 C     | Subroutine used to combine the atmos model data points at|
                0095 C     | the poles with their neighboring value, area weighted.   |
                0096 C     | The calcuated new value is overwritten into ind2.        |
                0097 C     *==========================================================*
                0098       IMPLICIT NONE
                0099 
                0100 
                0101 C     === Global Atmos/Ocean/Seaice Interface Variables ===
                0102 #include "ATMSIZE.h"
                0103 #include "AGRID.h"
                0104 #include "SIZE.h"
                0105 #include "EEPARAMS.h"
                0106 #include "ATM2D_VARS.h"
                0107 
                0108 C     !INPUT/OUTPUT PARAMETERS:
                0109 C     === Routine arguments ===
                0110 C     a1 - weighting of first index
                0111 C     a2 - weighting of second index
                0112 C     ind1 - first index into atmos data array
                0113 C     ind2 - first index into atmos data array
0efd285817 Jeff*0114 C     rsuma - recip of sum of ind1+ind2
09a6f3668a Jeff*0115       _RL     a1
                0116       _RL     a2
                0117       INTEGER ind1
                0118       INTEGER ind2
                0119       _RL  rsuma
                0120 
0efd285817 Jeff*0121 C     LOCAL VARIABLES:
09a6f3668a Jeff*0122 
                0123 C      atm_tauu(ind2)= (a1*atm_tauu(ind1) + a2*atm_tauu(ind2))*rsuma
                0124 C      atm_tauv(ind2)= (a1*atm_tauv(ind1) + a2*atm_tauv(ind2))*rsuma
                0125 C Tau variables not combined - zero at atm pole point
                0126 
                0127       atm_tair(ind2)= (a1*atm_tair(ind1) + a2*atm_tair(ind2))*rsuma
9274434acc Jean*0128       atm_precip(ind2)= (a1*atm_precip(ind1) +
09a6f3668a Jeff*0129      &                   a2*atm_precip(ind2))*rsuma
                0130       atm_runoff(ind2)= atm_runoff(ind1)+ atm_runoff(ind2)
9274434acc Jean*0131       atm_evap_ice(ind2)= (a1*atm_evap_ice(ind1) +
09a6f3668a Jeff*0132      &                     a2*atm_evap_ice(ind2))*rsuma
                0133       atm_evap_ocn(ind2)= (a1*atm_evap_ocn(ind1) +
                0134      &                     a2*atm_evap_ocn(ind2))*rsuma
9274434acc Jean*0135       atm_qnet_ice(ind2)= (a1*atm_qnet_ice(ind1)+
09a6f3668a Jeff*0136      &                     a2*atm_qnet_ice(ind2))*rsuma
                0137       atm_qnet_ocn(ind2)= (a1*atm_qnet_ocn(ind1) +
                0138      &                     a2*atm_qnet_ocn(ind2))*rsuma
9274434acc Jean*0139       atm_dFdt_ice(ind2)= (a1*atm_dFdt_ice(ind1)+
09a6f3668a Jeff*0140      &                     a2*atm_dFdt_ice(ind2))*rsuma
9274434acc Jean*0141       atm_dFdt_ocn(ind2)= (a1*atm_dFdt_ocn(ind1)+
09a6f3668a Jeff*0142      &                     a2*atm_dFdt_ocn(ind2))*rsuma
9274434acc Jean*0143       atm_dLdt_ice(ind2)= (a1*atm_dLdt_ice(ind1)+
09a6f3668a Jeff*0144      &                     a2*atm_dLdt_ice(ind2))*rsuma
9274434acc Jean*0145       atm_dLdt_ocn(ind2)= (a1*atm_dLdt_ocn(ind1)+
09a6f3668a Jeff*0146      &                     a2*atm_dLdt_ocn(ind2))*rsuma
9274434acc Jean*0147       atm_dFdt_iceq(ind2)= (a1*atm_dFdt_iceq(ind1)+
09a6f3668a Jeff*0148      &                      a2*atm_dFdt_iceq(ind2))*rsuma
9274434acc Jean*0149       atm_dFdt_ocnq(ind2)= (a1*atm_dFdt_ocnq(ind1)+
09a6f3668a Jeff*0150      &                      a2*atm_dFdt_ocnq(ind2))*rsuma
9274434acc Jean*0151       atm_dLdt_iceq(ind2)= (a1*atm_dLdt_iceq(ind1)+
09a6f3668a Jeff*0152      &                      a2*atm_dLdt_iceq(ind2))*rsuma
9274434acc Jean*0153       atm_dLdt_ocnq(ind2)= (a1*atm_dLdt_ocnq(ind1)+
09a6f3668a Jeff*0154      &                      a2*atm_dLdt_ocnq(ind2))*rsuma
9274434acc Jean*0155       atm_solarinc(ind2)= (a1*atm_solarinc(ind1) +
09a6f3668a Jeff*0156      &                     a2*atm_solarinc(ind2))*rsuma
                0157       atm_solar_ocn(ind2)= (a1*atm_solar_ocn(ind1)+
                0158      &                       a2*atm_solar_ocn(ind2))*rsuma
                0159       atm_solar_ice(ind2)= (a1*atm_solar_ice(ind1)+
                0160      &                     a2*atm_solar_ice(ind2))*rsuma
9274434acc Jean*0161       atm_windspeed(ind2)= (a1*atm_windspeed(ind1) +
09a6f3668a Jeff*0162      &                      a2*atm_windspeed(ind2))*rsuma
                0163       atm_slp(ind2)= (a1*atm_slp(ind1) + a2*atm_slp(ind2))*rsuma
                0164       atm_pco2(ind2)= (a1*atm_pco2(ind1)+a2*atm_pco2(ind2))*rsuma
9274434acc Jean*0165 
09a6f3668a Jeff*0166       RETURN
                0167       END
                0168 
                0169 
                0170 
                0171 
                0172
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!