*ID POLESCON
*/ 
*/ This is a FAMOUS mod. 
*/ 
*/ Rather than change POLAR & expect it not to matter for OMEGA_P, use
*/   new routine for all other calls ...
*/
*DECK NEWPOLAR
      SUBROUTINE NEWPOLAR(FIELD,
*CALL ARGFLDPT
     &                 FIELD_SIZE,ROW_LENGTH,N_LEVELS)
*COPY POLAR1A,APB2F401.105,109
*COPY POLAR1A,APB2F401.114,117
*CALL TYPFLDPT
*COPY POLAR1A,APB2F401.119,122
*IF DEF,MPP
      INTEGER info
*ENDIF
*COPY POLAR1A,APB2F401.131,141
*IF -DEF,MPP
*COPY POLAR1A,APB2F401.143,144
          MEAN_NP(K)=MEAN_NP(K)+FIELD(I+ROW_LENGTH,K)
          MEAN_SP(K)=MEAN_SP(K)+FIELD(I+FIELD_SIZE-2*ROW_LENGTH,K)
*COPY POLAR1A,APB2F401.147,152
          FIELD(I,K)=MEAN_NP(K)
          FIELD(I+FIELD_SIZE-ROW_LENGTH,K)=MEAN_SP(K)
*COPY POLAR1A,APB2F401.156,APB2F401.159
*ELSE
      IF (at_top_of_LPG) THEN
*IF DEF,REPROD
        CALL GCG_RVECSUMR(FIELD_SIZE,ROW_LENGTH-2*EW_Halo,
*ELSE
        CALL GCG_RVECSUMF(FIELD_SIZE,ROW_LENGTH-2*EW_Halo,
*ENDIF
     &                    2*ROW_LENGTH+1+EW_Halo,N_LEVELS,
     &                    FIELD,GC_ROW_GROUP,info,MEAN_NP)
*COPY POLAR1A,APB2F401.165,APB2F401.167
            FIELD(I,K)=MEAN_NP(K)
*COPY POLAR1A,APB2F401.169,APB2F401.173
*IF DEF,REPROD
        CALL GCG_RVECSUMR(FIELD_SIZE,ROW_LENGTH-2*EW_Halo,
*ELSE
        CALL GCG_RVECSUMF(FIELD_SIZE,ROW_LENGTH-2*EW_Halo,
*ENDIF
     &                    FIELD_SIZE-3*ROW_LENGTH+1+EW_Halo,N_LEVELS,
     &                    FIELD,GC_ROW_GROUP,info,MEAN_SP)
*COPY POLAR1A,APB2F401.177,APB2F401.179
            FIELD(I,K)=MEAN_SP(K)
*COPY POLAR1A,APB2F401.181,APB2F401.183
*ENDIF
*COPY POLAR1A,APB2F401.185,POLAR1A.66
*/
*DECLARE ATMPHY1
*D ATMPHY1.544,556
*D APB2F401.63
      CALL NEWPOLAR(D1(JTHETA(1)),
*D APB2F401.65,66
     &           P_FIELD,ROW_LENGTH,P_LEVELS)
*D ATMPHY1.573,595
*D APB2F401.70,71
      CALL NEWPOLAR(D1(JQ(1)),
*D APB2F401.73,74
     &           P_FIELD,ROW_LENGTH,Q_LEVELS)
*D APB2F401.78,79
      CALL NEWPOLAR(D1(JQCL(1)),
*D APB2F401.81,82
     &           P_FIELD,ROW_LENGTH,Q_LEVELS)
*D APB2F401.86,87
      CALL NEWPOLAR(D1(JQCF(1)),
*D APB2F401.89,90
     &           P_FIELD,ROW_LENGTH,Q_LEVELS)
*/
*/ Carry on using old sort of CALL from BL_CTL1 QTADV1A QTADV1C
*/   THADV1A THADV1C THADV1D THADV1E THQDIF1A THQDIF1B THQDIF1C
