Back to home page

MITgcm
 
 

    

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

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
4c105e462e Davi*0001 #include "AIM_OPTIONS.h"
                0002 
dbe1c243d5 Jean*0003 CBOP
                0004 C     !ROUTINE: AIM_DO_CO2
                0005 C     !INTERFACE:
                0006       SUBROUTINE AIM_DO_CO2( myTime, myIter, myThid )
                0007 
                0008 C     !DESCRIPTION: \bv
4c105e462e Davi*0009 C     *==========================================================*
dbe1c243d5 Jean*0010 C     | S/R AIM_DO_CO2
                0011 C     | o CO2 budget of the atmosphere
4c105e462e Davi*0012 C     *==========================================================*
dbe1c243d5 Jean*0013 C     \ev
                0014 C     !USES:
4c105e462e Davi*0015       IMPLICIT NONE
                0016 
                0017 C     == Global data ==
dbe1c243d5 Jean*0018 #include "SIZE.h"
4c105e462e Davi*0019 #include "EEPARAMS.h"
                0020 #include "PARAMS.h"
4ad994131f Jean*0021 #include "RESTART.h"
4c105e462e Davi*0022 #include "GRID.h"
                0023 
2a4f7f3ad0 Jean*0024 #include "AIM_PARAMS.h"
4c105e462e Davi*0025 #include "AIM_CO2.h"
870deba1f6 Davi*0026 C-- Coupled to the Ocean :
                0027 #ifdef COMPONENT_MODULE
                0028 #include "CPL_PARAMS.h"
                0029 #include "ATMCPL.h"
                0030 #endif
                0031 
dbe1c243d5 Jean*0032 C     !INPUT/OUTPUT PARAMETERS:
                0033 C     myTime :: Current time of simulation ( s )
                0034 C     myIter :: Current iteration number in simulation
                0035 C     myThid :: Number of this instance of the routine
4c105e462e Davi*0036       _RL myTime
dbe1c243d5 Jean*0037       INTEGER myIter, myThid
                0038 CEOP
4c105e462e Davi*0039 
                0040 #ifdef ALLOW_AIM
                0041 #ifdef ALLOW_AIM_CO2
dbe1c243d5 Jean*0042 C     !FUNCTIONS:
                0043       INTEGER  ILNBLNK, IFNBLNK
                0044       EXTERNAL ILNBLNK, IFNBLNK
                0045       LOGICAL  DIFFERENT_MULTIPLE
                0046       EXTERNAL DIFFERENT_MULTIPLE
870deba1f6 Davi*0047 
dbe1c243d5 Jean*0048 C     !LOCAL VARIABLES:
870deba1f6 Davi*0049 C     bi,bj  - Tile index
                0050 C     i,j    - loop counters
                0051       INTEGER bi, bj, i, j
                0052       _RL total_flux, atpco2_check
                0053       _RL flxCO2tile(nSx,nSy)
4ad994131f Jean*0054       LOGICAL modelEnd
                0055       LOGICAL permPickup, tempPickup
dbe1c243d5 Jean*0056       INTEGER iUnit, iLo, iHi
                0057       _RS dummyRS(1)
                0058       _RL tmpco2(2)
ab33782b56 Jean*0059       CHARACTER*(10) suff
dbe1c243d5 Jean*0060       CHARACTER*(MAX_LEN_FNAM) fn
                0061       CHARACTER*(MAX_LEN_MBUF) msgBuf
4c105e462e Davi*0062 
870deba1f6 Davi*0063 #ifdef COMPONENT_MODULE
dbe1c243d5 Jean*0064       IF ( useCoupler .AND. useImportFlxCO2 ) THEN
870deba1f6 Davi*0065        DO bj=myByLo(myThid),myByHi(myThid)
                0066         DO bi=myBxLo(myThid),myBxHi(myThid)
                0067          DO j=1,sNy
                0068           DO i=1,sNx
                0069            aimflxCo2(i,j,bi,bj) = flxCO2ocn(i,j,bi,bj)
dbe1c243d5 Jean*0070           ENDDO
4c105e462e Davi*0071          ENDDO
                0072         ENDDO
870deba1f6 Davi*0073        ENDDO
                0074       ENDIF
                0075 #endif /* COMPONENT_MODULE */
                0076 
2a4f7f3ad0 Jean*0077       IF ( aim_select_pCO2 .GE. 2 ) THEN
4c105e462e Davi*0078 
                0079 C- First compute global mole flux at air-sea interface
870deba1f6 Davi*0080         DO bj=myByLo(myThid),myByHi(myThid)
                0081          DO bi=myBxLo(myThid),myBxHi(myThid)
                0082           flxCO2tile(bi,bj) = 0. _d 0
                0083           DO j=1,sNy
                0084            DO i=1,sNx
                0085             flxCO2tile(bi,bj)=flxCO2tile(bi,bj) + aimflxCo2(i,j,bi,bj)
                0086      &                      * rA(i,j,bi,bj) * deltaT
                0087            ENDDO
                0088           ENDDO
4c105e462e Davi*0089          ENDDO
                0090         ENDDO
870deba1f6 Davi*0091         CALL GLOBAL_SUM_TILE_RL(flxCO2tile,total_flux,myThid)
4c105e462e Davi*0092 
870deba1f6 Davi*0093         _BARRIER
                0094         _BEGIN_MASTER(myThid)
4ad994131f Jean*0095         IF ( myIter.EQ.0 ) THEN
870deba1f6 Davi*0096 C- If  first iteration, use atmpCO2init as initial condition
2a4f7f3ad0 Jean*0097           atm_CO2_Moles = atm_pCO2 * total_atmos_moles
4c105e462e Davi*0098 
4ad994131f Jean*0099         ELSEIF ( myIter.EQ.nIter0 ) THEN
4c105e462e Davi*0100 C- If restart, read moles number from pickup
4ad994131f Jean*0101           IF ( pickupSuff.EQ.' ' ) THEN
ab33782b56 Jean*0102             IF ( rwSuffixType.EQ.0 ) THEN
                0103               WRITE(fn,'(A,I10.10)') 'pickup_aimCo2.', myIter
                0104             ELSE
                0105               CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
                0106               WRITE(fn,'(A,A)') 'pickup_aimCo2.', suff
                0107             ENDIF
4ad994131f Jean*0108           ELSE
                0109             WRITE(fn,'(A,A10)') 'pickup_aimCo2.', pickupSuff
                0110           ENDIF
dbe1c243d5 Jean*0111           iUnit = 0
                0112           CALL MDS_READVEC_LOC(  fn, precFloat64, iUnit, 'RL', 2,
                0113      O                           tmpco2, dummyRS,
                0114      I                           0, 0, 1, myThid )
2a4f7f3ad0 Jean*0115           atm_CO2_Moles = tmpco2(1)
4c105e462e Davi*0116           atpco2_check  = tmpco2(2)
2a4f7f3ad0 Jean*0117           atm_pCO2 = atm_CO2_Moles / total_atmos_moles
4c105e462e Davi*0118 
                0119           iUnit = standardMessageUnit
dbe1c243d5 Jean*0120           iLo = IFNBLNK(fn)
                0121           iHi = ILNBLNK(fn)
4c105e462e Davi*0122           WRITE(msgBuf,'(A)') ' '
                0123           CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)
                0124           WRITE(msgBuf,'(A)') '// ==================================='
                0125           CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)
dbe1c243d5 Jean*0126           WRITE(msgBuf,'(2A)') '// AIM_DO_CO2: Read pickup ',fn(iLo:iHi)
4c105e462e Davi*0127           CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)
                0128 
4da4b49499 Jean*0129           CALL WRITE_0D_RL( atpco2_check, INDEX_NONE, 'atpco2_check =',
870deba1f6 Davi*0130      &                     ' /* pCo2 from pickup file */')
                0131           CALL WRITE_0D_RL( atm_pCO2, INDEX_NONE, 'atm_pCO2 =',
2a4f7f3ad0 Jean*0132      &                     ' /* pCo2 from atm_CO2_Moles */')
4c105e462e Davi*0133         ENDIF
                0134 
                0135 C- Calculate new atmos pCO2
2a4f7f3ad0 Jean*0136         atm_CO2_Moles = atm_CO2_Moles - total_flux
                0137         atm_pCO2 = atm_CO2_Moles / total_atmos_moles
                0138 
                0139 C- Set pCO2 for AIM Radiation:
                0140         IF ( aim_select_pCO2 .EQ. 3 ) THEN
                0141           aim_pCO2 = atm_pCO2
                0142         ENDIF
4c105e462e Davi*0143 
                0144 C- Write out if time for a new pickup
4ad994131f Jean*0145         modelEnd = (myTime+deltaTClock).EQ.endTime
                0146      &        .OR. (myIter+1).EQ.nEndIter
                0147         permPickup = .FALSE.
                0148         tempPickup = .FALSE.
                0149         permPickup =
dbe1c243d5 Jean*0150      &    DIFFERENT_MULTIPLE(pChkptFreq,myTime+deltaTClock,deltaTClock)
4ad994131f Jean*0151         tempPickup =
                0152      &    DIFFERENT_MULTIPLE( chkptFreq,myTime+deltaTClock,deltaTClock)
                0153         IF ( (modelEnd.AND.writePickupAtEnd)
                0154      &       .OR. permPickup .OR. tempPickup ) THEN
                0155           IF ( permPickup ) THEN
ab33782b56 Jean*0156             IF ( rwSuffixType.EQ.0 ) THEN
                0157               WRITE(fn,'(A,I10.10)') 'pickup_aimCo2.', myIter+1
                0158             ELSE
                0159               CALL RW_GET_SUFFIX( suff,
                0160      &                    myTime+deltaTClock, myIter+1, myThid )
                0161               WRITE(fn,'(A,A)') 'pickup_aimCo2.', suff
                0162             ENDIF
4ad994131f Jean*0163           ELSE
ab33782b56 Jean*0164             WRITE(fn,'(A,A)') 'pickup_aimCo2.', checkPtSuff(nCheckLev)
4ad994131f Jean*0165           ENDIF
4c105e462e Davi*0166 C- write values to new pickup
2a4f7f3ad0 Jean*0167           tmpco2(1)= atm_CO2_Moles
870deba1f6 Davi*0168           tmpco2(2)= atm_pCO2
dbe1c243d5 Jean*0169           iUnit = 0
                0170           CALL MDS_WRITEVEC_LOC( fn, precFloat64, iUnit, 'RL', 2,
                0171      I                           tmpco2, dummyRS,
                0172      I                           0, 0, -1, myIter, myThid )
4c105e462e Davi*0173         ENDIF
870deba1f6 Davi*0174         _END_MASTER(myThid)
                0175         _BARRIER
4c105e462e Davi*0176 
2a4f7f3ad0 Jean*0177 C--- end if aim_select_pCO2 >= 2
4c105e462e Davi*0178       ENDIF
                0179 
                0180 #endif /* ALLOW_AIM_CO2 */
                0181 #endif /* ALLOW_AIM */
                0182 
                0183       RETURN
                0184       END
[ 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!