Changeset 12546 for NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/IOM/iom.F90

Timestamp:

2020-03-13T11:06:44+01:00 (4 years ago)

Author:

orioltp

Message:

Adding precision specification in hardcoded reals and other modifications to allow compilation without forcing reals without precision specification to a certain value through compiler flags

File:

• NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/IOM/iom.F90 (modified) (10 diffs)

NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/IOM/iom.F90

@@ -1311 +1311 @@
                !--- overlap areas and extra hallows (mpp)
                IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
-                  CALL lbc_lnk( 'iom', pv_r2d,'Z', -999., kfillmode = jpfillnothing )
+                  CALL lbc_lnk( 'iom', pv_r2d,'Z', -999.0_wp, kfillmode = jpfillnothing )
                ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN
                   ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
                   IF( icnt(3) == inlev ) THEN
-                     CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing )
+                     CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing )
                   ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...)
                      DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO
@@ -1340 +1340 @@
             CALL xios_recv_field( trim(cdvar), pv_r3d)
             IF(idom /= jpdom_unknown ) then
-                CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing)
+                CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing)
             ENDIF
          ELSEIF( PRESENT(pv_r2d) ) THEN
@@ -1347 +1347 @@
             CALL xios_recv_field( trim(cdvar), pv_r2d)
             IF(idom /= jpdom_unknown ) THEN
-                CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing)
+                CALL lbc_lnk('iom', pv_r2d,'Z',-999.0_wp, kfillmode = jpfillnothing)
             ENDIF
          ELSEIF( PRESENT(pv_r1d) ) THEN
@@ -1362 +1362 @@
 !some final adjustments
       ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain
-      IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1. )
-      IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1. )
+      IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1.0_wp )
+      IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1.0_wp )
 
       !--- Apply scale_factor and offset
@@ -1982 +1982 @@
          SELECT CASE ( cdgrd )
          CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:)
-         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1. )
-         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1. )
+         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1.0_wp )
+         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1.0_wp )
          CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1)
          END SELECT
@@ -2026 +2026 @@
       !
       z_fld(:,:) = 1._wp
-      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1. )    ! Working array for location of northfold
+      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp )    ! Working array for location of northfold
       !
       ! Cell vertices that can be defined
@@ -2044 +2044 @@
       ! Cell vertices on boundries
       DO jn = 1, 4
-         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pfillval=999._wp )
-         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pfillval=999._wp )
+         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1.0_wp, pfillval=999._wp )
+         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1.0_wp, pfillval=999._wp )
       END DO
       !
@@ -2116 +2116 @@
       ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp
       !
-!      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots)
-      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
+!      CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots)
+      CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
       CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
       CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
@@ -2198 +2198 @@
          cl1 = clgrd(jg)
          ! Equatorial section (attributs: jbegin, ni, name_suffix)
-         CALL dom_ngb( 0., 0., ix, iy, cl1 )
+         CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 )
          CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=jpiglo, nj=1 )
          CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             )
@@ -2424 +2424 @@
       !
       IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day
-         CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec )
+         CALL ju2ymds( pjday - 1.0_wp, iyear, imonth, iday, zsec )
          isec = 86400
       ENDIF